You and your friend Ilya are participating in an individual programming contest consisting of multiple stages. A contestant can get between $$$0$$$ and $$$100$$$ points, inclusive, for each stage, independently of other contestants.Points received by contestants in different stages are used for forming overall contest results. Suppose that $$$k$$$ stages of the contest are completed. For each contestant, $$$k - \lfloor \frac{k}{4} \rfloor$$$ stages with the highest scores are selected, and these scores are added up. This sum is the overall result of the contestant. (Here $$$\lfloor t \rfloor$$$ denotes rounding $$$t$$$ down.)For example, suppose $$$9$$$ stages are completed, and your scores are $$$50, 30, 50, 50, 100, 10, 30, 100, 50$$$. First, $$$7$$$ stages with the highest scores are chosen — for example, all stages except for the $$$2$$$-nd and the $$$6$$$-th can be chosen. Then your overall result is equal to $$$50 + 50 + 50 + 100 + 30 + 100 + 50 = 430$$$.As of now, $$$n$$$ stages are completed, and you know the points you and Ilya got for these stages. However, it is unknown how many more stages will be held. You wonder what the smallest number of additional stages is, after which your result might become greater than or equal to Ilya's result, at least in theory. Find this number!

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 a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of completed stages. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 100$$$) — your points for the completed stages. The third line contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$0 \le b_i \le 100$$$) — Ilya's points for the completed stages. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the smallest number of additional stages required for your result to be able to become greater than or equal to Ilya's result. If your result is already not less than Ilya's result, print $$$0$$$.

NoteIn the first test case, you have scored $$$100$$$ points for the first stage, while Ilya has scored $$$0$$$. Thus, your overall result ($$$100$$$) is already not less than Ilya's result ($$$0$$$).In the second test case, you have scored $$$0$$$ points for the first stage, while Ilya has scored $$$100$$$. A single stage with an opposite result is enough for both your and Ilya's overall scores to become equal to $$$100$$$.In the third test case, your overall result is $$$30 + 40 + 50 = 120$$$, while Ilya's result is $$$100 + 100 + 100 = 300$$$. After three additional stages your result might become equal to $$$420$$$, while Ilya's result might become equal to $$$400$$$.In the fourth test case, your overall result after four additional stages might become equal to $$$470$$$, while Ilya's result might become equal to $$$400$$$. Three stages are not enough.

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

scoreA sa n x = sa ! ((n+x) - div (n+x) 4 - x) + 100 * x
scoreB sb n x = sb ! min ((n+x) - div (n+x) 4) n

solve sa sb n x
            | scoreA sa n x < scoreB sb n x = solve sa sb n (x+1)
            | otherwise = x;

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    b <- readInts
    let sa = listArray (1,n) $ scanl1 (+) $ sortOn negate a
        sb = listArray (1,n) $ scanl1 (+) $ sortOn negate b
    print $ solve sa sb n 0

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

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

scoreA sa n x = sa ! ((n+x) - div (n+x) 4 - 1 - x) + 100 * x
scoreB sb n x = sb ! min ((n+x) - div (n+x) 4 - 1) (n-1)

solve sa sb n x
            | scoreA sa n x < scoreB sb n x = solve sa sb n (x+1)
            | otherwise = x;

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    b <- readInts
    let sa = listArray (0,n-1) $ scanl1 (+) $ sortOn negate a
        sb = listArray (0,n-1) $ scanl1 (+) $ sortOn negate b
    print $ solve sa sb n 0

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: Int -> [Int] -> [Int] -> Int -> Int -> Int
cnt le a b l r
  | l == r = l
  | mid_good = cnt le a b l mid
  | otherwise = cnt le a b (mid+1) r
  where mid = div (l+r) 2
        n = le + mid
        k = div n 4
        suma = sum (drop k a) + (mid - (max 0 (k - le))) * 100
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt n a b 0 n
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where mid = div (l+r) 2
        n = length a + mid
        k = div n 4
        suma = sum (drop k a) + (mid - (max 0 (k - length a))) * 100
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt a b 0 (2*n)
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import qualified Data.Array as A
import qualified Data.Sequence as S
import           Control.Monad (replicateM_)
import           Data.Maybe (fromJust)
import           Data.List (sort, sortOn)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      a_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      b_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      print $ solve n a_i b_i

solve :: Int -> [Int] -> [Int] -> Int
solve n me him
  | scoreMe n meArr >= scoreHim n himArr = 0
  | otherwise = binarySearch (n + 1, 2 * n) meArr himArr - n
  where
    meArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort me ++ repeat 100))

    himArr =
      A.array (1, 2 * n) (zip [1 .. 2 * n] (sortOn negate him ++ repeat 0))

scoreMe :: Int -> A.Array Int Int -> Int
scoreMe k arr = sum (map (arr A.!) [(minIndex + 1) .. k])
  where
    minIndex = k `div` 4

scoreHim :: (A.Ix i, Num a, Integral i) => i -> A.Array i a -> a
scoreHim k arr = sum (map (arr A.!) [1 .. (k - minIndex)])
  where
    minIndex = k `div` 4

{->>> scoreHim 20 (A.array (1,50) (zip [1..50] (sort [100,100,100,100]++repeat 0)))
400
-}
binarySearch :: (Int, Int) -> A.Array Int Int -> A.Array Int Int -> Int
binarySearch (lower, upper) me him
  | lower == upper = lower
  | scoreMe mid me >= scoreHim mid him = binarySearch (lower, mid) me him
  | otherwise = binarySearch (mid + 1, upper) me him
  where
    mid = (lower + upper) `div` 2
{-
>>>solve 7 [7 ,59 ,62 ,52 ,27 ,31 ,55] [33 ,35 ,50 ,98, 83, 80 ,64]
2

>>>

>>>solve 4 [4 ,10 ,20 ,30 ,40] [100 ,100, 100 ,100]
4

>>>solve 4 [20 ,30 ,40, 50] [100, 100, 100, 100]
3
>>>solve 2 [40 ,78] [82 ,67]
1
-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)

main :: IO ()
-- main = C.interact $ runScanner (C.pack <$> testCase)
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  n <- int
  as <- sort <$> n >< int
  bs <- sort <$> n >< int
  return . show $ solve as bs

solve :: [Int] -> [Int] -> Int
solve as bs = go 0 (4 * n)
  where
    n = length as
    gap = sum bs - sum as
    go l r
      | l == r = l
      | otherwise =
        let mid = (l + r) `div` 2
         in if check mid then go l mid else go (mid + 1) r
    check k =
      let d = (n + k) `div` 4
       in gap - sum (take (d - k) bs) <= 100 * (k - max 0 (d - n)) - sum (take d as)

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad hiding (ap)
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    ap <- scanl' (+) 0 . sort <$> readInts
    bp <- scanl' (+) 0 . sort <$> readInts
    let
      lap = last ap
      lbp = last bp
      res k = let
        ct = n + k
        toRem = div ct 4
        as = lap + k * 100 - ap !! toRem
        bs = lbp - bp !! max 0 (toRem - k)
        in  as - bs
      go x y
        | x == y  = x
        | otherwise = let
            w = x + div (y - x) 2
            in  if  res w >= 0
                then  go x w
                else  go (w+1) y
    putInts [go 0 n]

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where k = div (length a) 4
        mid = div (l+r) 2
        suma = sum (drop k a) + 100 * mid
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt a b 0 (2*n)
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where k = div (length a) 4
        mid = div (l+r) 2
        suma = sum (drop k a) + 100 * mid
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      maxrnd = max 0 $ (sum b - sum a) `div` 100 + 1
      res = cnt a b 0 maxrnd
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import qualified Data.Array as A
import qualified Data.Sequence as S
import           Control.Monad (replicateM_)
import           Data.Maybe (fromJust)
import           Data.List (sort)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      a_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      b_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      print $ solve n a_i b_i

solve :: Int -> [Int] -> [Int] -> Int
solve n me him
  | scoreMe n meArr >= scoreHim n himArr = 0
  | otherwise = binarySearch (n + 1, 2 * n) meArr himArr - n
  where
    meArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort me ++ repeat 100))

    himArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort him ++ repeat 0))

scoreMe :: Int -> A.Array Int Int -> Int
scoreMe k arr = sum (map (arr A.!) [minIndex + 1 .. k])
  where
    minIndex = k `div` 4

scoreHim :: (A.Ix i, Num a, Integral i) => i -> A.Array i a -> a
scoreHim k arr = sum (map (arr A.!) [1 .. (k - minIndex)])
  where
    minIndex = k `div` 4

{->>> score 4 (A.array (1,18) (zip [1..18] (sort [100,100,100,100])))
300
-}
binarySearch :: (Int, Int) -> A.Array Int Int -> A.Array Int Int -> Int
binarySearch (lower, upper) me him
  | lower + 1 >= upper = upper
  | scoreMe mid me >= scoreHim mid him = binarySearch (lower, mid) me him
  | otherwise = binarySearch (mid + 1, upper) me him
  where
    mid = (lower + upper + 1) `div` 2
{-
>>>solve 7 [7 ,59 ,62 ,52 ,27 ,31 ,55] [33 ,35 ,50 ,98, 83, 80 ,64]
ProgressCancelledException

>>>solve 4 [4 ,10 ,20 ,30 ,40] [100 ,100, 100 ,100]
4

>>>solve 4 [20 ,30 ,40, 50] [100, 100, 100, 100]
3

-}


"The zombies are lurking outside. Waiting. Moaning. And when they come...""When they come?""I hope the Wall is high enough."Zombie attacks have hit the Wall, our line of defense in the North. Its protection is failing, and cracks are showing. In places, gaps have appeared, splitting the wall into multiple segments. We call on you for help. Go forth and explore the wall! Report how many disconnected segments there are.The wall is a two-dimensional structure made of bricks. Each brick is one unit wide and one unit high. Bricks are stacked on top of each other to form columns that are up to R bricks high. Each brick is placed either on the ground or directly on top of another brick. Consecutive non-empty columns form a wall segment. The entire wall, all the segments and empty columns in-between, is C columns wide.

The first line of the input consists of two space-separated integers R and C, 1 ≤ R, C ≤ 100. The next R lines provide a description of the columns as follows:    each of the R lines contains a string of length C,  the c-th character of line r is B if there is a brick in column c and row R - r + 1, and . otherwise.  B

The number of wall segments in the input configuration.

NoteIn the first sample case, the 2nd and 3rd columns define the first wall segment, and the 5th column defines the second.

import Control.Monad
import Data.List

solve :: [[Char]] -> Int
solve fld = length $ filter (\a -> any (\b -> b /= '.') a) pairs
  where
    bottom = last fld
    pairs = groupBy (\a b -> a == b) bottom

main :: IO ()
main = do
  r <- liftM words getLine
  mat <- replicateM (read $ head r) getLine
  print $ solve mat

import Control.Applicative ((<$>))
import Control.Monad (replicateM)

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

dot2Space :: Char -> Char
dot2Space c = case c of
    '.' -> ' '
    x -> x

main = do
    [r, c] <- readNums
    ground <- last <$> (replicateM r getLine)
    let numSegments = length $ words $ (map dot2Space) ground
    putStrLn $ show  numSegments


You've got table a, consisting of n rows, numbered from 1 to n. The i-th line of table a contains ci cells, at that for all i (1 < i ≤ n) holds ci ≤ ci - 1. Let's denote s as the total number of cells of table a, that is, . We know that each cell of the table contains a single integer from 1 to s, at that all written integers are distinct. Let's assume that the cells of the i-th row of table a are numbered from 1 to ci, then let's denote the number written in the j-th cell of the i-th row as ai, j. Your task is to perform several swap operations to rearrange the numbers in the table so as to fulfill the following conditions:  for all i, j (1 < i ≤ n; 1 ≤ j ≤ ci) holds ai, j > ai - 1, j;  for all i, j (1 ≤ i ≤ n; 1 < j ≤ ci) holds ai, j > ai, j - 1. In one swap operation you are allowed to choose two different cells of the table and swap the recorded there numbers, that is the number that was recorded in the first of the selected cells before the swap, is written in the second cell after it. Similarly, the number that was recorded in the second of the selected cells, is written in the first cell after the swap.Rearrange the numbers in the required manner. Note that you are allowed to perform any number of operations, but not more than s. You do not have to minimize the number of operations.

The first line contains a single integer n (1 ≤ n ≤ 50) that shows the number of rows in the table. The second line contains n space-separated integers ci (1 ≤ ci ≤ 50; ci ≤ ci - 1) — the numbers of cells on the corresponding rows. Next n lines contain table а. The i-th of them contains ci space-separated integers: the j-th integer in this line represents ai, j. It is guaranteed that all the given numbers ai, j are positive and do not exceed s. It is guaranteed that all ai, j are distinct.

In the first line print a single integer m (0 ≤ m ≤ s), representing the number of performed swaps. In the next m lines print the description of these swap operations. In the i-th line print four space-separated integers xi, yi, pi, qi (1 ≤ xi, pi ≤ n; 1 ≤ yi ≤ cxi; 1 ≤ qi ≤ cpi). The printed numbers denote swapping the contents of cells axi, yi and api, qi. Note that a swap operation can change the contents of distinct table cells. Print the swaps in the order, in which they should be executed.

import Data.List
import Data.Maybe

main :: IO ()
main = do n  <- getLine >>= return . read
          lc <- getLine >>= return . map read . words
          l  <- sequence $ replicate n (getLine >>= return . map read . words)
          let ans = solve n lc l
          putStrLn $ show $ length ans
          sequence_ $ map (putStrLn . unwords . map show) ans

solve :: Int -> [Int] -> [[Int]] -> [[Int]]
solve n lc l = map g . filter (\ (x,y) -> x/=y) $(fromJust (f sorted list 0))
    where
        list = concat l
        sorted = sort list
        f [] _ _ = Just []
        f (x:xs) (y:ys) idx = do i  <- elemIndex x (y:ys)
                                 let ys' = tail (set i y (y:ys))
                                 l  <- f xs ys' (idx+1)
                                 return ((idx,idx+i):l)
        set 0 e (x:xs) = e:xs
        set n e (x:xs) = x:set (n-1) e xs
        lc' = scanl (+) 0 lc
        g (x,y) = let (i,j) = convert x
                      (k,l) = convert y
                  in [i,j,k,l]
        convert idx = (i,j+1)
            where i = fromJust $ findIndex (>idx) lc'
                  j = idx - lc' !! (i-1)

import Control.Monad (liftM)
import Data.Array
--import Data.Map (Map, empty, fromList, insert)

type Size   =  Array Int Int
type Table  =  Array (Int, Int) Int
type Swap   =  ((Int, Int), (Int, Int))

parseTable :: Size -> [Int] -> Table
parseTable cs xs  =  accum (flip const) zeroArray $ getList (1, 1) xs
  where
    zeroArray  =  accumArray undefined 0 ((1,1), (n, cs ! 1)) []
    n  =  snd $ bounds cs
    getList (i, j) []  =  []
    getList (i, j) (x:xs)
      | j > cs ! i  =  getList (i+1, 1) (x:xs)
      | otherwise  =  ((i, j), x) : getList (i, j+1) xs

solve :: Size -> Table -> [Swap]
solve cs table  =  solve' (1,1) 1 table
  where
    n  =  sum $ elems cs
    solve' (i,j) m table
      | m == n  =  []
      | j > cs ! i  =  solve' (i+1,1) m table
      | table ! (i,j) == m  =  solve' (i,j+1) (m+1) table
      | otherwise  =  ((iM,jM), (i,j)) : solve' (i,j+1) (m+1) (table // [((iM,jM), table ! (i,j)), ((i,j), m)])
        where
          (iM,jM)  =  fst $ head $ dropWhile ((/= m) . snd) $ assocs table

prints :: [Swap] -> IO ()
prints swaps  =  print (length swaps) >> mapM_ print' swaps
  where
    print' ((i1,j1), (i2,j2))  =  putStrLn $
        concat [show i1, " ", show j1, " ", show i2, " ", show j2]

main :: IO ()
main  =  do
    n  <-  readLn
    cs  <-  liftM (listArray (1,n) . fmap read . words) getLine :: IO (Array Int Int)
    xs  <-  liftM (parseTable cs . fmap read . words) getContents :: IO Table
    prints $ solve cs xs

{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import qualified Data.Set as S
import Data.List
import Data.Ord

main = do
  n <- readLn
  ijs <- sortBy(comparing$uncurry (+)).concat.zipWith(\i ci->map(i,)[1..ci])[1..].map read.words <$> getLine
  tblSet <- fmap(S.fromList.concat).forM [1..n] $ \i->
    zipWith(\j x->(x,i,j))[1..].map read.words <$> getLine
  let ans = solve ijs tblSet
  print $ length ans
  putStrLn.unlines.map(unwords.map show) $ ans

solve :: [(Int,Int)] -> S.Set (Int,Int,Int) -> [[Int]]
solve [] _ = []
solve ((i,j):ijs) set
  | (i,j) == (x,y) = solve ijs rest
  | otherwise = [i,j,x,y]:solve ijs (S.insert (v2,x,y) rest2)
   where
     ((_,x,y),rest) = S.deleteFindMin set
     (rest1,rest2)=S.partition(\(_,x,y)->x==i && y==j)rest
     (v2,_,_) = S.findMin rest1

import Data.List
import Data.Maybe

main :: IO ()
main = do n  <- getLine >>= return . read
          lc <- getLine >>= return . map read . words
          l  <- sequence $ replicate n (getLine >>= return . map read . words)
          let ans = solve n lc l
          putStrLn $ show $ length ans
          sequence_ $ map (putStrLn . unwords . map show) ans

solve :: Int -> [Int] -> [[Int]] -> [[Int]]
solve n lc l = map g (fromJust (f sorted list 0))
    where
        list = concat l
        sorted = sort list
        f [] _ _ = Just []
        f (x:xs) (y:ys) idx = do i  <- elemIndex x (y:ys)
                                 let ys' = tail (set i y (y:ys))
                                 l  <- f xs ys' (idx+1)
                                 return ((idx,idx+i):l)
        set 0 e (x:xs) = e:xs
        set n e (x:xs) = x:set (n-1) e xs
        lc' = scanl (+) 0 lc
        g (x,y) = let (i,j) = convert x
                      (k,l) = convert y
                  in [i,j,k,l]
        convert idx = (i,j+1)
            where i = fromJust $ findIndex (>idx) lc'
                  j = idx - lc' !! (i-1)


Masha works in an advertising agency. In order to promote the new brand, she wants to conclude contracts with some bloggers. In total, Masha has connections of $$$n$$$ different bloggers. Blogger numbered $$$i$$$ has $$$a_i$$$ followers.Since Masha has a limited budget, she can only sign a contract with $$$k$$$ different bloggers. Of course, Masha wants her ad to be seen by as many people as possible. Therefore, she must hire bloggers with the maximum total number of followers.Help her, find the number of ways to select $$$k$$$ bloggers so that the total number of their followers is maximum possible. Two ways are considered different if there is at least one blogger in the first way, which is not in the second way. Masha believes that all bloggers have different followers (that is, there is no follower who would follow two different bloggers).For example, if $$$n=4$$$, $$$k=3$$$, $$$a=[1, 3, 1, 2]$$$, then Masha has two ways to select $$$3$$$ bloggers with the maximum total number of followers:   conclude contracts with bloggers with numbers $$$1$$$, $$$2$$$ and $$$4$$$. In this case, the number of followers will be equal to $$$a_1 + a_2 + a_4 = 6$$$.  conclude contracts with bloggers with numbers $$$2$$$, $$$3$$$ and $$$4$$$. In this case, the number of followers will be equal to $$$a_2 + a_3 + a_4 = 6$$$. Since the answer can be quite large, output it modulo $$$10^9+7$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 1000$$$) — the number of bloggers and how many of them you can sign a contract with. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots a_n$$$ ($$$1 \le a_i \le n$$$) — the number of followers of each blogger. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$.

For each test case, on a separate line output one integer — the number of ways to select $$$k$$$ bloggers so that the total number of their followers is maximum possible.

NoteThe test case is explained in the statements.In the second test case, the following ways are valid:   conclude contracts with bloggers with numbers $$$1$$$ and $$$2$$$. In this case, the number of followers will be equal to $$$a_1 + a_2 = 2$$$;  conclude contracts with bloggers with numbers $$$1$$$ and $$$3$$$. In this case, the number of followers will be equal to $$$a_1 + a_3 = 2$$$;  conclude contracts with bloggers with numbers $$$1$$$ and $$$4$$$. In this case, the number of followers will be equal to $$$a_1 + a_4 = 2$$$;  conclude contracts with bloggers with numbers $$$2$$$ and $$$3$$$. In this case, the number of followers will be equal to $$$a_2 + a_3 = 2$$$;  conclude contracts with bloggers with numbers $$$2$$$ and $$$4$$$. In this case, the number of followers will be equal to $$$a_2 + a_4 = 2$$$;  conclude contracts with bloggers with numbers $$$3$$$ and $$$4$$$. In this case, the number of followers will be equal to $$$a_3 + a_4 = 2$$$. In the third test case, the following ways are valid:   concludes a contract with a blogger with the number $$$2$$$. In this case, the number of followers will be equal to $$$a_2 = 2$$$.

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM) -- foldM est un foldl
import Data.Maybe

numOcc :: Ord a => [a] -> M.Map a Integer
numOcc (x:xs) = let m = numOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
numOcc [] = M.empty

numOcc' :: A.Ix a => (a, a) -> [a] -> A.Array a Integer
numOcc' size list = runSTArray $ do
	array <- MA.newArray size 0
	foldM (addElem array) () list
	return array

	where
		addElem :: A.Ix a=> STArray s a Integer -> () -> a -> ST s ()
		addElem array action a = do
			i <- MA.readArray array a
			MA.writeArray array a (i+1)

insertWithList :: Ord a => a -> b -> M.Map a [b] -> M.Map a [b]
insertWithList a b m = case M.lookup a m of
	Just l -> M.insert a (b:l) m
	Nothing -> M.insert a [b] m

deleteWithList :: Ord a => a -> M.Map a [b] -> M.Map a [b]
deleteWithList a m = case M.lookup a m of
	Just (x:y:xs) -> M.insert a (y:xs) m
	Just [x] -> M.delete a m

solve :: Integer -> Integer -> [Integer] -> Integer
solve n k a = result k occM where
	occM = numOcc a

	result k occ
		| num >= k = k `parmi` num
		| k > num = result (k-num) occ'
		where
			(key, num) = M.findMax occ
			occ' = M.delete key occ

	parmi k num
		| k == 0 = 1
		| num == 0 = 1
		| otherwise = (num * parmi (k-1) (num-1)) `div` k

plotResult n = print $ mod n 1000000007

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n, k] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		a <- fmap ((fmap read) . words) getLine :: IO [Integer]
		plotResult $ solve n k a

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Semigroup
import Data.Int

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

p :: Int
p = 10^(9 :: Int) + 7

mul :: Int -> Int -> Int
mul x y = let
  p' :: Int64
  [x', y', p'] = map fromIntegral [x, y, p]
  in  fromIntegral $ mod (x' * y') p'

newtype W = W { unw :: Int }

instance  Semigroup W  where
  W x <> W y = W $ mul x y

inv :: Int -> Int
inv = unw . stimes (p-2) . W

choose :: Int -> Int -> Int
choose n k = let
  step v i = mul v . mul (n+1-i) $ inv i
  in  foldl' step 1 [1..k]

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, k] <- readInts
    a <- readInts
    let
      sa = reverse $ sort a
      tarV = sa !! (k-1)
      ct1 = length [x | x <- sa, x == tarV]
      ct2 = length [x | x <- take k sa, x == tarV]
    outLine . P.pack . show $ ct1 `choose` ct2


You are given an array $$$a$$$ with $$$n$$$ non-negative integers. You can apply the following operation on it.   Choose two indices $$$l$$$ and $$$r$$$ ($$$1 \le l < r \le n$$$).  If $$$a_l + a_r$$$ is odd, do $$$a_r := a_l$$$. If $$$a_l + a_r$$$ is even, do $$$a_l := a_r$$$. Find any sequence of at most $$$n$$$ operations that makes $$$a$$$ non-decreasing. It can be proven that it is always possible. Note that you do not have to minimize the number of operations.An array $$$a_1, a_2, \ldots, a_n$$$ is non-decreasing if and only if $$$a_1 \le a_2 \le \ldots \le a_n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Each test case consists of two lines. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$)  — the array itself. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, print one integer $$$m$$$ ($$$0 \le m \le n$$$), the number of operations, in the first line. Then print $$$m$$$ lines. Each line must contain two integers $$$l_i, r_i$$$, which are the indices you chose in the $$$i$$$-th operation ($$$1 \le l_i < r_i \le n$$$). If there are multiple solutions, print any of them.

NoteIn the second test case, $$$a$$$ changes like this:  Select indices $$$3$$$ and $$$4$$$. $$$a_3 + a_4 = 3$$$ is odd, so do $$$a_4 := a_3$$$. $$$a = [1, 1000000000, 3, 3, 5]$$$ now.  Select indices $$$1$$$ and $$$2$$$. $$$a_1 + a_2 = 1000000001$$$ is odd, so do $$$a_2 := a_1$$$. $$$a = [1, 1, 3, 3, 5]$$$ now, and it is non-decreasing. In the first and third test cases, $$$a$$$ is already non-decreasing.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

{- aux -}
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

{- solution -}

compositeFactors :: Int64 -> [Int64]
compositeFactors n = L.map L.head . L.group . L.sort $ compositeFactors'
    where
        compositeFactors' = L.concat $ do
            d <- [1 .. ceiling . sqrt $ fromIntegral n]
            M.guard $ n `mod` d == 0
            return $ [d, n `div` d]

solve :: Int -> [Int] -> [(Int, Int)]
solve n as = answer
    where
        oddity = even $ L.head as
        (fsts, snds) = L.partition ((== oddity) . even . snd) . L.zip [1..] $ as
        (fstI, fstV) = L.last fsts
        answer = (L.map (\(i, a) -> (i, fstI)) $ L.init fsts) ++ (L.map (\(i, a) -> (1, i)) $ snds)

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


It is the easy version of the problem. The only difference is that in this version $$$n = 1$$$.In the cinema seats can be represented as the table with $$$n$$$ rows and $$$m$$$ columns. The rows are numbered with integers from $$$1$$$ to $$$n$$$. The seats in each row are numbered with consecutive integers from left to right: in the $$$k$$$-th row from $$$m (k - 1) + 1$$$ to $$$m k$$$ for all rows $$$1 \le k \le n$$$. $$$1$$$$$$2$$$$$$\cdots$$$$$$m - 1$$$$$$m$$$$$$m + 1$$$$$$m + 2$$$$$$\cdots$$$$$$2 m - 1$$$$$$2 m$$$$$$2m + 1$$$$$$2m + 2$$$$$$\cdots$$$$$$3 m - 1$$$$$$3 m$$$$$$\vdots$$$$$$\vdots$$$$$$\ddots$$$$$$\vdots$$$$$$\vdots$$$$$$m (n - 1) + 1$$$$$$m (n - 1) + 2$$$$$$\cdots$$$$$$n m - 1$$$$$$n m$$$ The table with seats indices There are $$$nm$$$ people who want to go to the cinema to watch a new film. They are numbered with integers from $$$1$$$ to $$$nm$$$. You should give exactly one seat to each person.It is known, that in this cinema as lower seat index you have as better you can see everything happening on the screen. $$$i$$$-th person has the level of sight $$$a_i$$$. Let's define $$$s_i$$$ as the seat index, that will be given to $$$i$$$-th person. You want to give better places for people with lower sight levels, so for any two people $$$i$$$, $$$j$$$ such that $$$a_i < a_j$$$ it should be satisfied that $$$s_i < s_j$$$.After you will give seats to all people they will start coming to their seats. In the order from $$$1$$$ to $$$nm$$$, each person will enter the hall and sit in their seat. To get to their place, the person will go to their seat's row and start moving from the first seat in this row to theirs from left to right. While moving some places will be free, some will be occupied with people already seated. The inconvenience of the person is equal to the number of occupied seats he or she will go through.Let's consider an example: $$$m = 5$$$, the person has the seat $$$4$$$ in the first row, the seats $$$1$$$, $$$3$$$, $$$5$$$ in the first row are already occupied, the seats $$$2$$$ and $$$4$$$ are free. The inconvenience of this person will be $$$2$$$, because he will go through occupied seats $$$1$$$ and $$$3$$$.Find the minimal total inconvenience (the sum of inconveniences of all people), that is possible to have by giving places for all people (all conditions should be satisfied).

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$n = 1$$$, $$$1 \le m \le 300$$$) — the number of rows and places in each row respectively. The second line of each test case contains $$$n \cdot m$$$ integers $$$a_1, a_2, \ldots, a_{n \cdot m}$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the sight level of $$$i$$$-th person. It's guaranteed that the sum of $$$n \cdot m$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the minimal total inconvenience that can be achieved.

NoteIn the first test case, there is a single way to arrange people, because all sight levels are distinct. The first person will sit on the first seat, the second person will sit on the second place, the third person will sit on the third place. So inconvenience of the first person will be $$$0$$$, inconvenience of the second person will be $$$1$$$ and inconvenience of the third person will be $$$2$$$. The total inconvenience is $$$0 + 1 + 2 = 3$$$.In the second test case, people should sit as follows: $$$s_1 = 2$$$, $$$s_2 = 1$$$, $$$s_3 = 5$$$, $$$s_4 = 4$$$, $$$s_5 = 3$$$. The total inconvenience will be $$$6$$$.

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    [1, m] <- readMany :: IO [Int]
    as <- readMany :: IO [Int]
    let xs = map snd $ sortOn (negate . fst) $ zip as [1 :: Int ..]
    print $ sum [length $ filter (<i) xs' | (i:xs') <- tails xs]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solve

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function (on)
import Data.List (groupBy, sort)
import Data.Maybe (fromJust)

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

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

input :: Scanner TC
input = do
  n <- int
  m <- int
  as <- (n * m) >< int
  return TC {..}

solve :: TC -> Int
solve TC {..} =
  fst
    . foldl update (0, [])
    . map (sort . map snd)
    . groupOn fst
    . sort
    $ zip as [1 ..]
  where
    update (acc, row) ixs = (acc + cost, tetris $ row ++ ixs)
      where
        cixs = take (m - length row) ixs
        cost = sum [countBy (< i) row | i <- cixs]

    tetris xs = let l = length xs in drop (l - l `mod` m) xs

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

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 qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import qualified Data.Set as S
import Data.Function
import Data.Int

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = unfoldr $ \li -> do
  guard $ not $ null li
  pure $ splitAt n li

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    a <- getInts (n * m)
    let
      aips = sort $ zip a [1..]
      unsrows = chunksOf m aips
      soln row = do
        w <- groupBy ((==) `on` fst) row
        reverse $ map snd w
      rows = map soln unsrows
      cost :: [Int] -> Int64
      cost row = let
        incls = scanl' (flip S.insert) S.empty row
        in  foldl' (+) 0 $ do
        (i, s) <- zip row incls
        pure $ fromIntegral $ S.size $ fst $ S.split i s
    pure $ putInt64s [foldl' (\x y -> x + cost y) 0 rows]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


Sonya decided that having her own hotel business is the best way of earning money because she can profit and rest wherever she wants.The country where Sonya lives is an endless line. There is a city in each integer coordinate on this line. She has $$$n$$$ hotels, where the $$$i$$$-th hotel is located in the city with coordinate $$$x_i$$$. Sonya is a smart girl, so she does not open two or more hotels in the same city.Sonya understands that her business needs to be expanded by opening new hotels, so she decides to build one more. She wants to make the minimum distance from this hotel to all others to be equal to $$$d$$$. The girl understands that there are many possible locations to construct such a hotel. Thus she wants to know the number of possible coordinates of the cities where she can build a new hotel. Because Sonya is lounging in a jacuzzi in one of her hotels, she is asking you to find the number of cities where she can build a new hotel so that the minimum distance from the original $$$n$$$ hotels to the new one is equal to $$$d$$$.

The first line contains two integers $$$n$$$ and $$$d$$$ ($$$1\leq n\leq 100$$$, $$$1\leq d\leq 10^9$$$) — the number of Sonya's hotels and the needed minimum distance from a new hotel to all others. The second line contains $$$n$$$ different integers in strictly increasing order $$$x_1, x_2, \ldots, x_n$$$ ($$$-10^9\leq x_i\leq 10^9$$$) — coordinates of Sonya's hotels.

Print the number of cities where Sonya can build a new hotel so that the minimum distance from this hotel to all others is equal to $$$d$$$.

NoteIn the first example, there are $$$6$$$ possible cities where Sonya can build a hotel. These cities have coordinates $$$-6$$$, $$$5$$$, $$$6$$$, $$$12$$$, $$$13$$$, and $$$19$$$.In the second example, there are $$$5$$$ possible cities where Sonya can build a hotel. These cities have coordinates $$$2$$$, $$$6$$$, $$$13$$$, $$$16$$$, and $$$21$$$.

import Data.List.Split as Split

stringToInt s = read s :: Int

possible n_d x_n =
  let [_n, d] = map stringToInt $ Split.splitOn " " n_d
      x = map stringToInt $ Split.splitOn " " x_n
  in show (2 + (behind d x))

behind d (x1:[]) = 0
behind d (x1:x2:xs) =
  case compare (2*d) (x2 - x1) of
    EQ -> 1 + behind d (x2:xs)
    GT -> behind d (x2:xs)
    LT -> 2 + behind d (x2:xs)

main = do
  n_d <- getLine
  x_n <- getLine
  putStrLn (possible n_d x_n)

import Data.List
import qualified Data.Set as Set

f::Integer->[Integer]->Integer
f _ (x:[])=2
f k (x:y:zs)
   |x+k<y-k=2+(f k (y:zs))
   |x+k==y-k=1+(f k (y:zs))
   |otherwise=f k (y:zs)

main = do
       e1<-getLine
       es<-getLine
       let (n:k:[])=map read (words e1)::[Integer]
           xs=map read (words es)::[Integer]
       print $ f k xs


Little girl Tanya climbs the stairs inside a multi-storey building. Every time Tanya climbs a stairway, she starts counting steps from $$$1$$$ to the number of steps in this stairway. She speaks every number aloud. For example, if she climbs two stairways, the first of which contains $$$3$$$ steps, and the second contains $$$4$$$ steps, she will pronounce the numbers $$$1, 2, 3, 1, 2, 3, 4$$$.You are given all the numbers pronounced by Tanya. How many stairways did she climb? Also, output the number of steps in each stairway.The given sequence will be a valid sequence that Tanya could have pronounced when climbing one or more stairways.

The first line contains $$$n$$$ ($$$1 \le n \le 1000$$$) — the total number of numbers pronounced by Tanya. The second line contains integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 1000$$$) — all the numbers Tanya pronounced while climbing the stairs, in order from the first to the last pronounced number. Passing a stairway with $$$x$$$ steps, she will pronounce the numbers $$$1, 2, \dots, x$$$ in that order. The given sequence will be a valid sequence that Tanya could have pronounced when climbing one or more stairways.

In the first line, output $$$t$$$ — the number of stairways that Tanya climbed. In the second line, output $$$t$$$ numbers — the number of steps in each stairway she climbed. Write the numbers in the correct order of passage of the stairways.

import Data.List

toint s = (read s) :: Integer

doit [] i = [i]
doit (x:xs) i =
	if x == 1 && i > 0 then
		i:(doit xs 1)
	else
		doit xs (i+1)

solve::String -> String
solve ss =
	let s = map toint (tail (words ss)) in
	let r = doit s 0 in
	(show (length r)) ++ "\n" ++ intercalate " " (map show r) ++ "\n"

main = do
  interact $ solve

-- Codeforces 1005 A
import Data.List
foldCount :: [Int] -> [Int]
foldCount list = (\(n, l) -> tail l ++ [n]) $ foldl' func (0, []) list
    where func :: (Int, [Int]) -> Int -> (Int, [Int])
          func (x, l) 1 = (1, l++[x])
          func (_, l) x = (x, l)

main :: IO ()
main = do
    n <- getLine
    list <- getLine >>= return.foldCount.(map read).words :: IO [Int]
    putStrLn $ show $ length list
    putStrLn $ unwords $ map show list

f::[Int]->[Int]
f (x:[])=[x]
f (x:y:xs)
   |x<y=f (y:xs)
   |otherwise=x:f (y:xs)

main = do
       e<-getLine
       e2<-getLine
       let xs=map read (words e2)::[Int]
           ys=f xs
       putStrLn $ (show(length ys))++"\n"++(unwords $ map show $ ys)

{-# LANGUAGE ScopedTypeVariables #-}

import Prelude
import Data.Maybe
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor
import Control.Monad.ST.Safe
import Data.STRef
import qualified Data.Array.IArray as IA
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as A
import qualified Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8

main :: IO ()
main = do
    (n :: Int) <- read <$> getLine
    (arr :: [Int]) <- (map read . words) <$> getLine
    let answer = map fst . filter (\(x, y) -> x + 1 /= y) $ zip arr (tail arr ++ [1])
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char
-- import Data.List.HT

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

-- segmentBefore :: (a -> Bool) -> [a] -> [[a]]
-- segmentBefore _ [] = []
-- segmentBefore p s = foldr (\b a-> if p b then [] : [b : head a] ++ tail a else [b : head a] ++ tail a) [] s

segmentBefore :: (a -> Bool) -> [a] -> [[a]]
segmentBefore p =
--   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]
   uncurry (:) .
   foldr
      (\ x ~(y,ys) ->
         let xs = x:y
         in  if p x then ([],xs:ys) else (xs,ys))
      ([],[])

solve :: [Int] -> (Int, [Int])
solve xs = (length a, map last a)
    where a = tail $ segmentBefore (==1) xs

main :: IO ()
main = do
    n <- readInt
    xs <- readInts
    let r = solve xs
    print $ fst r
    putStrLn $ unwords . map show $ snd r

main = interact $ format . solve . map read . tail . words
solve as = filter (> 0) $ map succ $ zipWith (-) as (tail as ++ [1])
format ss = unlines [ show (length ss) , unwords (map show ss) ]

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

process n x [f] = do
			print $ n+1
			putStrLn $ intercalate " " $ map show (x++[f])

process n x (a:b:c) | a<b = process n x (b:c)
                    | otherwise = process (n+1) (x++[a])  (b:c)

main= do
		a<- read <$> getLine ::IO Int
		s<- map read <$> words <$> getLine ::IO [Int]
		process 0 [] s

--ghc 7.10

import Data.List(groupBy)

listStairwaySteps :: [Int] -> [Int]
listStairwaySteps = map length . groupBy (<)

main = do
    line1 <- getLine
    line2 <- getLine
    let a = map read . words $ line2
    let b = listStairwaySteps a
    let k = length b
    print k
    putStrLn . unwords . map show $ b

main = interact $ pureMain

pureMain :: String -> String
pureMain s = unlines $ map (unwords . map show) $ [length ans]:ans:[]
  where
    [[n], a] = map (map read . words) $ lines s
    (_, ans) = foldr (\ v (pre, l) -> if pre == 1 then (v, v:l) else (v, l)) (1, []) a


There are $$$n$$$ block towers in a row, where tower $$$i$$$ has a height of $$$a_i$$$. You're part of a building crew, and you want to make the buildings look as nice as possible. In a single day, you can perform the following operation:  Choose two indices $$$i$$$ and $$$j$$$ ($$$1 \leq i, j \leq n$$$; $$$i \neq j$$$), and move a block from tower $$$i$$$ to tower $$$j$$$. This essentially decreases $$$a_i$$$ by $$$1$$$ and increases $$$a_j$$$ by $$$1$$$. You think the ugliness of the buildings is the height difference between the tallest and shortest buildings. Formally, the ugliness is defined as $$$\max(a)-\min(a)$$$. What's the minimum possible ugliness you can achieve, after any number of days?

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. Then $$$t$$$ cases follow. The first line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the number of buildings. The second line of each test case contains $$$n$$$ space separated integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^7$$$) — the heights of the buildings.

For each test case, output a single integer — the minimum possible ugliness of the buildings.

NoteIn the first test case, the ugliness is already $$$0$$$.In the second test case, you should do one operation, with $$$i = 1$$$ and $$$j = 3$$$. The new heights will now be $$$[2, 2, 2, 2]$$$, with an ugliness of $$$0$$$.In the third test case, you may do three operations:   with $$$i = 3$$$ and $$$j = 1$$$. The new array will now be $$$[2, 2, 2, 1, 5]$$$,  with $$$i = 5$$$ and $$$j = 4$$$. The new array will now be $$$[2, 2, 2, 2, 4]$$$,  with $$$i = 5$$$ and $$$j = 3$$$. The new array will now be $$$[2, 2, 3, 2, 3]$$$.  The resulting ugliness is $$$1$$$. It can be proven that this is the minimum possible ugliness for this test.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    pure $ putInts $ pure $ case  quotRem (sum a) n  of
      (_, 0) -> 0
      _ -> 1

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


Vasya has got two number: a and b. However, Vasya finds number a too short. So he decided to repeat the operation of lengthening number a n times.One operation of lengthening a number means adding exactly one digit to the number (in the decimal notation) to the right provided that the resulting number is divisible by Vasya's number b. If it is impossible to obtain the number which is divisible by b, then the lengthening operation cannot be performed.Your task is to help Vasya and print the number he can get after applying the lengthening operation to number a n times.

The first line contains three integers: a, b, n (1 ≤ a, b, n ≤ 105).

In a single line print the integer without leading zeros, which Vasya can get when he applies the lengthening operations to number a n times. If no such number exists, then print number -1. If there are multiple possible answers, print any of them.

import Data.Char (intToDigit)

main :: IO ()
main = do
  [a, b, n] <- fmap (map read . words) getLine
  let d = head $ filter (\i -> mod (a * 10 + i) b == 0) [0 .. 9] ++ [-1]
  if d == -1
    then putStrLn "-1"
    else putStrLn $ show a ++ [intToDigit d] ++ replicate (n - 1) '0'

import qualified Data.ByteString.Char8 as B
import Data.List

main = putStrLn . show . solve . map (toInteger . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Integer] -> Integer
solve [a, b, n] = case f a b of
  x : _ -> x * 10 ^ (n-1)
  _ -> -1
  where
  f a b = [a' | c <- [0..9], let a' = a * 10 + c, rem a' b == 0]

import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: [Int] -> String
solve [a, b, n]  =  case x of
    []  ->  "-1"
    (x:xs)  ->  show a ++ show x ++ replicate (n - 1) '0'
  where
    x  =  filter (\c -> (10*a + c) `mod` b == 0) [0 .. 9]

main :: IO ()
main  =  reads >>= putStrLn . solve

-- Codeforces 260A

-- At first try to add to the right one digit from 0 to 9.
-- If it is impossible write -1.
-- In other case, the remaining n–1 digits can be 0 because divisibility doesn’t change.

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

solve :: [Int] -> String
solve [a, b, n] = if null k then "-1" else show (head k) ++ replicate (n-1) '0' where k = filter (\x -> x `mod` b == 0) $ map (a * 10 +) [0..9]

extend b a
  | null e    = -1
  | otherwise = head e
  where e = filter (\x -> x `mod` b == 0) $ map (\x -> a * 10 + x) [0 .. 9]

solve a b n
  | c == -1   = "-1"
  | otherwise = show c ++ replicate (n - 1) '0'
  where c = extend b a

main = do [a, b, n] <- fmap words getLine
          putStrLn $ solve (read a) (read b) (read n)

readInts :: String -> [Int]
readInts str = map read (words str)

main :: IO ()
main = do
  [a, b, n] <- fmap readInts getLine
  let s = mod (a*10+9) b
  if s>9 then print (-1)
  else do
    putStr $ show a
    putStr $ show $ 9-s
    putStr $ replicate (n-1) '0'

main=do
  [a,b,n] <- fmap(map read.words)getLine
  putStrLn $ f a b n

f a b n
  | null xs = "-1"
  | otherwise = show x0++replicate(n-1)'0'
   where
     xs = [y|x<-[0..9],let y=10*a+x,mod y b<1]
     x0 = head xs

main = getContents >>= putStr.concatMap show.solve.map read.words

solve :: [Int] -> [Int]
solve (a:b:n:[])
	| ((b - ((a*10) `mod` b)) `mod` b) > 9 = [-1]
	| otherwise = a:fir:replicate (n-1) 0
		where fir = (b - ((a*10) `mod` b)) `mod` b

import Control.Applicative
import Data.List
import Data.Char

extend a b 0 = a
extend a b n = if z <10  then extend (x+z) b (n-1) else if y==0 then x*10^(n-1) else (-1)
	where x = a*10
	      y = mod x b
              z = b - y

main= do
	 [a,b,n]<-  map read. words <$>getLine  ::IO [Integer]
	 print $ extend a b n

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n
f :: Integer -> Integer -> Integer -> Integer
f a b n =
  if (a*10)`mod`b==0 then (a*10)*10^(n-1) else
  if b-((a*10)`mod`b)<=9 then (a*10+b-((a*10)`mod`b))*10^(n-1) else
  -1

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n

f :: Integer -> Integer -> Integer -> Integer
f a b n = if n == 0 then a else
	if can a 0 b then (a*10+0)*10^(n-1) else
	if can a 1 b then (a*10+1)*10^(n-1) else
	if can a 2 b then (a*10+2)*10^(n-1) else
	if can a 3 b then (a*10+3)*10^(n-1) else
	if can a 4 b then (a*10+4)*10^(n-1) else
	if can a 5 b then (a*10+5)*10^(n-1) else
	if can a 6 b then (a*10+6)*10^(n-1) else
	if can a 7 b then (a*10+7)*10^(n-1) else
	if can a 8 b then (a*10+8)*10^(n-1) else
	if can a 9 b then (a*10+9)*10^(n-1) else
	 -1

can :: Integer -> Integer -> Integer -> Bool
can a d b  = if (10*a+d) `mod` b == 0 then True else False

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n
f :: Integer -> Integer -> Integer -> Integer
f a b n =
  if a*10`mod`b==0 then a*10^n else
  if b-a*10`mod`b<=9 then (a*10+b-(a*10`mod`b))*10^(n-1) else
  -1

extend :: Int -> Int -> Int -> Maybe (Int, Int)
extend a b 0 = Just (a, 0)
extend a b n =
  let m = (a * 10) `mod` b
      d = (b - m) `mod` b
      in if 0 <= d && d < 10 then Just (10*a + d, n-1) else Nothing

main = do
  inpStr <- getLine
  let [a, b, n] = map (read :: String -> Int) $ words inpStr
    in case (extend a b n) of
      Nothing -> putStrLn "-1"
      Just (m, k)  -> putStrLn $ (show m) ++ (replicate k '0')

func a b n
    | null xs = "-1"
    | otherwise = show a ++ show (head xs) ++ replicate (n - 1) '0'
    where
      xs = [y | y <- [0 .. 9], (a * 10 + y) `mod` b == 0]

main = do
  [a, b, n] <- fmap (map read . words) getLine
  putStrLn $ func a b n

main :: IO ()
main = getLine >>= putStrLn . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = 10*a + x, mod y b == 0]

import qualified Data.ByteString.Char8 as B
import Data.List

main = putStrLn . show . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve [a, b, n] = case f a b n of
  x : _ -> x
  _ -> -1
  where
  f a b 0 = [a]
  f a b n = concat [f a' b (n-1) | c <- [0..9], let a' = a * 10 + c, rem a' b == 0]

main = getContents >>= putStr.concatMap show.solve.map read.words

solve :: [Int] -> [Int]
solve (a:b:n:[])
	| (b - ((a*10) `mod` b)) > 9 = [-1]
	| n > 1 && b > 9 = [-1]
	| otherwise = a:fir:replicate (n-1) b
		where fir = b - ((a*10) `mod` b)

import Control.Applicative
import Data.List
import Data.Char

extend a b 0 = a
extend a b n = if z <10 then extend (x+z) b (n-1) else (-1)
	where x = a*10
	      y = mod x b
              z = b - y

main= do
	 [a,b,n]<-  map read. words <$>getLine  ::IO [Integer]
	 print $ extend a b n

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n

f :: Integer -> Integer -> Integer -> Integer
f a b n = if n == 0 then a else
	if can a 0 b then (a*10+0)*10^(n-1) else
	if can a 1 b then (a*10+1)*10^(n-1) else
	if can a 2 b then (a*10+2)*10^(n-1) else
	if can a 3 b then (a*10+3)*10^(n-1) else
	if can a 4 b then (a*10+4)*10^(n-1) else
	if can a 5 b then (a*10+5)*10^(n-1) else
	if can a 6 b then (a*10+6)*10^(n-1) else
	if can a 7 b then (a*10+7)*10^(n-1) else
	if can a 8 b then (a*10+8)*10^(n-1) else
	if can a 0 b then (a*10+9)*10^(n-1) else
	 -1

can :: Integer -> Integer -> Integer -> Bool
can a d b  = if (10*a+d) `mod` b == 0 then True else False

extend a b 0 = Just a
extend a b n =
  let m = (a * 10) `mod` b
      d = (b - m) `mod` b
      in if 0 <= d && d < 10 then extend (10*a + d) b (n-1) else Nothing

main = do
  inpStr <- getLine
  let [a, b, n] = map (read :: String -> Int) $ words inpStr
    in case (extend a b n) of
      Nothing -> putStrLn "-1"
      Just m -> putStrLn (show m)

main :: IO ()
main = getLine >>= print . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = (10 * a + x) `mod` b == 0]

main :: IO ()
main = getLine >>= print . f . map (read :: String -> Int) . words

f :: [Int] -> Int
f (a:b:n:_)
  | null xs = -1
  | otherwise = (10*a + head xs) * (10 ^ (n-1))
  where
        xs = [y | y <- [0..9], (10 * a + y) `mod` b == 0]

main :: IO ()
main = getLine >>= putStrLn . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = (10 * a + x) `mod` b == 0]


A string is called a k-string if it can be represented as k concatenated copies of some string. For example, the string "aabaabaabaab" is at the same time a 1-string, a 2-string and a 4-string, but it is not a 3-string, a 5-string, or a 6-string and so on. Obviously any string is a 1-string.You are given a string s, consisting of lowercase English letters and a positive integer k. Your task is to reorder the letters in the string s in such a way that the resulting string is a k-string.

The first input line contains integer k (1 ≤ k ≤ 1000). The second line contains s, all characters in s are lowercase English letters. The string length s satisfies the inequality 1 ≤ |s| ≤ 1000, where |s| is the length of string s.

Rearrange the letters in string s in such a way that the result is a k-string. Print the result on a single output line. If there are multiple solutions, print any of them. If the solution doesn't exist, print "-1" (without quotes).

import Data.List
main=interact$(\[k,s] -> f (read k) (group$sort s)).words
divides k s = length s `mod` k == 0
f k grp
  | (any (==False).map (divides k)) grp = "-1"
  | otherwise = build k grp
build k grp = concat (replicate k (concat (map (\s -> replicate ((length s) `quot` k) (head s)) grp)))

import Control.Applicative
import Data.List

main = do
  k <- fmap read getLine
  s <- fmap (map (liftA2 (,) length head) . group . sort) getLine
  if all (\(n, _) -> mod n k == 0) s
    then putStrLn $ concat $ replicate k $ concatMap (\(n, a) -> replicate (div n k) a) s
    else print $ -1

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-List.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Char.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- http://en.wikibooks.org/wiki/Haskell/Next_steps

sameList :: Int -> a -> [a]
sameList n a
	| n == 0 	= []
	| otherwise = (a : (sameList (n - 1) a))

getCount :: String -> [Int]
getCount [] 	 = sameList 26 0
getCount (a : b) = update a (getCount b)

update :: Char -> [Int] -> [Int]
update c a = (take i a) ++ [(a !! i) + 1] ++ (drop (i + 1) a)
	where i = (fromEnum c) - (fromEnum 'a')

check :: Int -> [Int] -> Bool
check k []		= True
check k (a:b) 	= (mod a k == 0) && check k b

copy :: Int -> String -> String
copy 0 _ 	= []
copy k s	= s ++ copy (k - 1) s

collate :: Int -> [Int] -> Int -> String
collate k cnt c
	| c >= 26 + fromEnum 'a'	= []
	| otherwise					= (sameList (div (head cnt) k) ch) ++
								(collate k (tail cnt) (c + 1))
		where ch = toEnum c

main :: IO()
main = do
	str <- getContents
	let input = words str
	let k = read (input !! 0)
	let cnt = getCount (input !! 1)
	if (check k cnt)
		then putStrLn (copy k (collate k cnt (fromEnum 'a')))
		else putStrLn "-1"

import List (group, sort)

solve :: Int -> String -> Maybe String
solve k s
  | all ((0 ==) . flip mod k . length) s'  =  Just $ take (length s) $ cycle $ concatMap (\s -> take (div (length s) k) s) s'
  | otherwise  =  Nothing
  where
    s'  =  group $ sort s

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    putStrLn $ maybe "-1" id $ solve n s

import Data.List
import Control.Applicative
import Debug.Trace

solve :: Int -> String -> String
solve k s
  | canSolve = concat $ take k $ repeat s'
  | otherwise = "-1"
  where
    track q = trace (show q) q
    grouped = group $ sort s
    canSolve = all (\x -> x `mod` k == 0) $ map length grouped
    s' = concat $ map (\x -> take (length x `div` k) x) $ grouped

main = do
  k <- read <$> getLine
  s <- getLine
  putStrLn $ solve k s

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) . group . sort

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs = maybe "-1" (([1..k] >>) . concat) $ mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) $ group $ sort cs

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\xs@(x:_) -> case divMod (length xs) k of (d, 0) -> Just (replicate d x); _ -> Nothing) . group . sort

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs | all ((==0) . (`mod`k)) $ map length $ group $ sort cs =
               [1..k] >> concatMap (\x -> take (length x `div` k) x) (group $ sort cs)
           | otherwise = "-1"

import Data.List
import Control.Arrow
main = do
  k <- readLn
  s <- getLine
  let fs = map (length &&& head) $ group $ sort s
  if all ((==0) . (`mod` k) . fst) fs
    then putStrLn $ concat $ replicate k $ concat $ map (uncurry replicate . first (`div` k)) fs
    else print (-1)

import Data.List

toKString :: Int -> String -> Maybe String
toKString k s | length s `mod` k /= 0 = Nothing
              | otherwise = toKString' k s
  where
    toKString' _ [] = Just ""
    toKString' k s = do
      a <- if all (== head s) (take k s)
           then Just $ head s
           else Nothing
      rest <- toKString' k (drop k s)
      return $ a : rest

main = do
  k <- readLn
  s <- getLine
  case toKString k $ sort s of
    Just s' -> putStrLn $ concat $ replicate k s'
    _       -> putStrLn "-1"

import Data.Char
import Data.List

count :: String -> Char -> Int
count s c = length $ filter (\x -> x == c) s

solve :: Int -> String -> String
solve k s = let z = getIt s 'a' 'z' k in if z == "-1" then z else repeat' k z

repeat' :: Int -> String -> String
repeat' 0 s = ""
repeat' a s = s ++ (repeat' (a - 1) s)

getIt :: String -> Char -> Char -> Int -> String
getIt s c to k = if c > to then "" else
                if mod (count s c) k /= 0 then "-1" else
                 let
                     z = getIt s (toEnum(fromEnum(c) + 1)) to k
                     u = count s c
                 in
                   if z == "-1" then z
                       else (replicate (div u k) c) ++ z
main = do n <- getLine
          s <- getLine
          putStrLn $ solve (read n) s

import Data.Array
import Control.Applicative
import Control.Monad

main = do
  k <- readLn
  cs <- filter((0<).snd).assocs.accumArray (+) 0 ('a','z').(`zip`repeat 1) <$> getLine
  if all ((0==).(`mod`k).snd) cs
     then replicateM_ k $ forM cs $ \(c,i)-> putStr $ replicate (i`div`k) c
     else print $ -1

import Data.List
main = do
    [kStr,s] <- fmap lines getContents
    let k = read kStr::Int
        sortedS = sort s
        numChars = map length $ group sortedS
        result = if all (\x -> x`rem`k == 0) numChars
            then concat $ replicate k $ takeEvery k sortedS
            else "-1"
    putStrLn result

takeEvery :: Int -> [a] -> [a]
takeEvery n [] = []
takeEvery n (x:xs) = x : (takeEvery n $ drop (n-1) xs)

import Data.List

calc :: Int -> String -> Maybe String
calc k s = if all (\t -> length t `mod` k == 0) xs
           then Just $ (foldl1 (++) . replicate k) $ kString1 xs
           else Nothing
  where
    xs = group $ sort s
    kString1 []     = ""
    kString1 (x:xs) = take (length x `div` k) x ++ kString1 xs

main = do s <- getLine
          t <- getLine
          case calc (read s) t of
            Just x  -> putStrLn x
            Nothing -> print (-1) -- -1 は括弧で囲む必要がある

import Control.Applicative
import Data.List

main= do
	k<-  read  <$> getLine ::IO Int
	s<-getLine
	let (a,b)=  unzip $ map (\z-> (head z, length z)) $ group $ sort s
	let c= all (==0) ( map (\z-> mod z k) b)
	let d = map (\z-> div z k) b
	putStrLn $ if c then concat $ replicate k $ concat $ zipWith (\x y -> replicate y x) a d else "-1"

import List (group, sort)

solve :: Int -> String -> Maybe String
solve k s
  | all ((0 ==) . flip mod k . length) s'  =  Just $ concatMap (\s -> take (div (length s) k) s) s'
  | otherwise  =  Nothing
  where
    s'  =  group $ sort s

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    putStrLn $ maybe "-1" id $ solve n s

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\xs@(x:_) -> if length xs `mod` k == 0 then Just (replicate k x) else Nothing) . group . sort

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs = maybe "-1" concat $ mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) $ group $ sort cs

import Control.Applicative
import Data.List

main= do
	k<-  read  <$> getLine ::IO Int
	s<-getLine
	let (a,b)=  unzip $ map (\z-> (head z, length z)) $ group $ sort s
	let c= all (==0) ( map (\z-> mod z k) b)
	let d = map (\z-> div z k) b
	putStrLn $ if c then concat $ replicate k $ concat $ zipWith (\x y -> replicate y x) a d else ""


As a German University in Cairo (GUC) student and a basketball player, Herr Wafa was delighted once he heard the news. GUC is finally participating in the Annual Basketball Competition (ABC). A team is to be formed of n players, all of which are GUC students. However, the team might have players belonging to different departments. There are m departments in GUC, numbered from 1 to m. Herr Wafa's department has number h. For each department i, Herr Wafa knows number si — how many students who play basketball belong to this department.Herr Wafa was also able to guarantee a spot on the team, using his special powers. But since he hates floating-point numbers, he needs your help at finding the probability that he will have at least one teammate belonging to his department. Note that every possible team containing Herr Wafa is equally probable. Consider all the students different from each other.

The first line contains three integers n, m and h (1 ≤ n ≤ 100, 1 ≤ m ≤ 1000, 1 ≤ h ≤ m) — the number of players on the team, the number of departments in GUC and Herr Wafa's department, correspondingly.  The second line contains a single-space-separated list of m integers si (1 ≤ si ≤ 100), denoting the number of students in the i-th department. Note that sh includes Herr Wafa.

Print the probability that Herr Wafa will have at least one teammate from his department. If there is not enough basketball players in GUC to participate in ABC, print -1. The answer will be accepted if it has absolute or relative error not exceeding 10 - 6.

NoteIn the first example all 3 players (2 from department 1 and 1 from department 2) must be chosen for the team. Both players from Wafa's departments will be chosen, so he's guaranteed to have a teammate from his department.In the second example, there are not enough players.In the third example, there are three possibilities to compose the team containing Herr Wafa. In two of them the other player from Herr Wafa's department is part of the team.

module Main where

import Control.Monad

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Int]

    let sh = s !! (h-1)
        ss = sum s

    if ss < n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ res --fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: (Num b, Integral a) => a -> a -> b -> Double
compute _ _ 0 = 1
compute sh ss n = ( 1 - fromIntegral sh / fromIntegral ss ) * compute sh (ss-1) (n-1)

toI l = map read $ words l :: [Int]
--comp s h = product [(s - h + 1) .. s]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = 1 - (product d)
        where
            a = [(s - h - n  + 2)..(s - h)]
            b = [(s-n + 1)..(s-1)]
            c = zip a b
            d = [(fromIntegral h1) / (fromIntegral h2) | (h1, h2) <- c ]

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    let sh = s!!(h-1)
    let ss = sum s
    --print $ comp (ss - n + 1) sh
    print $ solve n ss sh

module Main where

import Control.Monad
import Data.Ratio

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Integer]

    let sh = s !! (h-1)
        ss = sum s

    if ss < fromIntegral n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: (Num b, Integral a) => a -> a -> b -> Ratio a
compute _ _ 0 = 1
compute sh ss n = ( 1 - sh % ss ) * compute sh (ss-1) (n-1)

module Main where

import Control.Monad
import Data.Ratio

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Int]

    let sh = s !! (h-1)
        ss = sum s

    if ss < n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: Integral a => a -> a -> a -> Ratio a
compute _ _ 0 = 1
compute sh ss n = ( 1 - sh % ss ) * compute sh (ss-1) (n-1)

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | n > s = -1
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))

toI l = map read $ words l :: [Int]
--comp s h = product [(s - h + 1) .. s]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = 1 - ((fromIntegral a) / (fromIntegral b))
        where
            a = product [(s - h - n  + 2)..(s - h)]
            b = product [(s-n + 1)..(s-1)]

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    let sh = s!!(h-1)
    let ss = sum s
    --print $ comp (ss - n + 1) sh
    print $ solve n ss sh

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | h == 1 = 0
    | n > s = -1
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))


Leha somehow found an array consisting of n integers. Looking at it, he came up with a task. Two players play the game on the array. Players move one by one. The first player can choose for his move a subsegment of non-zero length with an odd sum of numbers and remove it from the array, after that the remaining parts are glued together into one array and the game continues. The second player can choose a subsegment of non-zero length with an even sum and remove it. Loses the one who can not make a move. Who will win if both play optimally?

First line of input data contains single integer n (1 ≤ n ≤ 106) — length of the array. Next line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 109).

Output answer in single line. "First", if first player wins, and "Second" otherwise (without quotes).

NoteIn first sample first player remove whole array in one move and win.In second sample first player can't make a move and lose.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd (sum xs) || any odd xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

import qualified Data.ByteString as B (getLine)
import Data.ByteString.Char8 (readInt, words)
import Control.Applicative
import Prelude hiding (words)
import Data.Maybe (fromJust)

solve xs
  | odds == 0 = "Second"
  | otherwise = "First"
  where odds = length $ filter odd xs

main = do
  B.getLine >> B.getLine >>= putStrLn.solve.map (fst.fromJust.readInt).words

import Control.Applicative( (<$>))
import Data.List( foldl')
import Data.ByteString.Char8( readInt, getLine, words	)
import qualified Data.ByteString.Char8 as C8
import Data.Maybe( fromJust)

main = do
    let
	readBS2Int = fst . fromJust . readInt
	readLine2Ints = map readBS2Int . C8.words <$> C8.getLine
    _n_ <- readLn::IO Int
    as_ <- readLine2Ints
    let
	isOdds = odd <$> as_

	initNumOdds = foldl' f 0 isOdds
			where
			    f v a = if a then v+1 else v

	initOdd = odd initNumOdds

    putStr $ if initOdd
		then "First"
		else if initNumOdds /= 0
		    then "First"
		    else "Second"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

main = do
    B.getLine
    (dropWhile (even . readInt) . C.words -> odds) <- B.getLine
    putStrLn $ if null odds then "Second" else "First"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

main = do
    B.getLine
    (length . filter odd . map readInt . C.words -> nodd) <- B.getLine
    putStrLn $ if nodd > 0 then "First" else "Second"

-- 841B

{-# LANGUAGE OverloadedStrings #-}

import Data.ByteString.Lazy.Char8 (ByteString(..), readInt, words, interact)
import Data.Maybe
import Prelude hiding (interact, words)

main = getLine >> (interact $ f . words)

f :: [ByteString] -> ByteString
f nums = if any isOdd nums
         then "First\n"
         else "Second\n"

isOdd = odd . fst . fromJust . readInt

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd (sum xs) || all even xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd $ sum xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Integer] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "First\n"
         else "Second\n"

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Int] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "First\n"
         else "Second\n"

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Int] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "Second\n"
         else "First\n"


Let's call an array $$$t$$$ dominated by value $$$v$$$ in the next situation.At first, array $$$t$$$ should have at least $$$2$$$ elements. Now, let's calculate number of occurrences of each number $$$num$$$ in $$$t$$$ and define it as $$$occ(num)$$$. Then $$$t$$$ is dominated (by $$$v$$$) if (and only if) $$$occ(v) > occ(v')$$$ for any other number $$$v'$$$. For example, arrays $$$[1, 2, 3, 4, 5, 2]$$$, $$$[11, 11]$$$ and $$$[3, 2, 3, 2, 3]$$$ are dominated (by $$$2$$$, $$$11$$$ and $$$3$$$ respectevitely) but arrays $$$[3]$$$, $$$[1, 2]$$$ and $$$[3, 3, 2, 2, 1]$$$ are not.Small remark: since any array can be dominated only by one number, we can not specify this number and just say that array is either dominated or not.You are given array $$$a_1, a_2, \dots, a_n$$$. Calculate its shortest dominated subarray or say that there are no such subarrays.The subarray of $$$a$$$ is a contiguous part of the array $$$a$$$, i. e. the array $$$a_i, a_{i + 1}, \dots, a_j$$$ for some $$$1 \le i \le j \le n$$$.

The first line contains single integer $$$T$$$ ($$$1 \le T \le 1000$$$) — the number of test cases. Each test case consists of two lines. The first line contains single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the corresponding values of the array $$$a$$$. It's guaranteed that the total length of all arrays in one test doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$T$$$ integers — one per test case. For each test case print the only integer — the length of the shortest dominated subarray, or $$$-1$$$ if there are no such subarrays.

NoteIn the first test case, there are no subarrays of length at least $$$2$$$, so the answer is $$$-1$$$.In the second test case, the whole array is dominated (by $$$1$$$) and it's the only dominated subarray.In the third test case, the subarray $$$a_4, a_5, a_6$$$ is the shortest dominated subarray.In the fourth test case, all subarrays of length more than one are dominated.

import qualified Data.Map as Map
import Data.Maybe
import Control.Monad

type State = (Map.Map Int Index, Maybe Int)
type Indexed a = (Index,a)
type Index = Int

step :: State -> Indexed Int-> State
step (m,Just c) (index,n) = (newMap,Just $ min c d)
  where
    newMap = Map.insert n index m
    d =1+ index - fromMaybe 0 (Map.lookup n m)
step (m, Nothing) (index,n) = (newMap,d)
  where
    newMap = Map.insert n index m
    d =(\x ->1 + index - x) <$> Map.lookup n m

solve :: [Int] -> Maybe Int
solve l = snd $ foldl step (Map.empty,Nothing) (zip [0..] l)

routine :: IO ()
routine = do
   _ <- getLine
   l <- fmap (map read.words) getLine
   print $ fromMaybe (-1) $ solve l

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

-- http://codeforces.com/problemset/problem/1257/C

import           Control.Monad
import qualified Data.Map      as Map
import           Data.Maybe

type Case = [Int]
type History = Map.Map
data Record = Record { latestIndex   :: Int
                     , minDifference :: Maybe Int
                     } deriving (Show)

filterTestCases :: [String] -> [String]
filterTestCases lines =
  map snd -- get the values of the indexed list = [2]
  $ filter (odd . fst) -- filter the list by odd indices = [(1,2)]
  $ zip [0..] lines -- create an indexed list = [(0,1),(1,2),(2,3)]

toCase :: String -> Case
toCase line = map read $ words line :: Case

updateRecord :: Int -> Int -> Record -> Record
updateRecord key index record
  | minDifference record == Nothing = record { latestIndex = index, minDifference = currentDifference }
  | currentDifference < minDifference record = record { latestIndex = index, minDifference = currentDifference }
  | otherwise = record { latestIndex = index }
  where currentDifference = Just $ index - latestIndex record

updateHistory :: Int -> Int -> History Int Record -> History Int Record
updateHistory key index history
  | Map.notMember key history = Map.insert key Record { latestIndex=index, minDifference=Nothing } history
  | Map.member key history = Map.insert key (updateRecord key index (fromJust $ Map.lookup key history)) history

getMin :: [Maybe Int] -> Maybe Int
getMin []   = Nothing
getMin list = foldr1 min list

solveRecursive :: Case -> Int -> History Int Record -> Maybe Int
solveRecursive [] index history
  | Map.size history == 0 = Nothing
  | otherwise = getMin $ filter isJust $ map minDifference $ Map.elems history
solveRecursive (x:xs) index history =
  solveRecursive xs (index + 1) $ updateHistory x index history

solve :: Case -> Int
solve [] = -1
solve (x:xs)
  | isNothing solution = -1
  | otherwise = 1 + (fromJust solution)
  where solution = solveRecursive xs (index + 1) history
        history = Map.singleton x Record {latestIndex=index, minDifference=Nothing}
        index = 0

main :: IO ()
main = interact $ unlines . map (show . solve . toCase) . filterTestCases . tail . lines