When he's not training for IOI, Little Alawn enjoys playing with puzzles of various types to stimulate his brain. Today, he's playing with a puzzle that consists of a $$$2 \times n$$$ grid where each row is a permutation of the numbers $$$1,2,3,\ldots,n$$$.The goal of Little Alawn's puzzle is to make sure no numbers on the same column or row are the same (we'll call this state of the puzzle as solved), and to achieve this he is able to swap the numbers in any column. However, after solving the puzzle many times, Little Alawn got bored and began wondering about the number of possible solved configurations of the puzzle he could achieve from an initial solved configuration only by swapping numbers in a column.Unfortunately, Little Alawn got stuck while trying to solve this harder problem, so he was wondering if you could help him with it. Find the answer modulo $$$10^9+7$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 4 \cdot 10^5$$$). The next two lines of each test case describe the initial state of the puzzle grid. Each line will be a permutation of the numbers $$$1,2,3,\ldots,n$$$ and the numbers in each column and row will be pairwise distinct. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$4 \cdot 10^5$$$.

For each test case output a single integer, the number of possible solved configurations of the puzzle Little Alawn can achieve from an initial solved configuration only by swapping numbers in a column. As the answer can be very large, please output it modulo $$$10^9+7$$$. The answer for each test case should be on a separate line.

NoteThe two possible puzzle configurations for example $$$1$$$ are:  $$$[1,4,2,3]$$$ in the first row and $$$[3,2,1,4]$$$ in the second;  $$$[3,2,1,4]$$$ in the first row and $$$[1,4,2,3]$$$ in the second.

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

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

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

md :: Int64
md = 1000000007

newtype MInt = MInt Int64 deriving Eq

instance Show MInt where
    show (MInt a) = show a

instance Num MInt where
    (MInt a) + (MInt b) =
        let r = a + b in
            MInt $ if r >= md then r - md else r
    (MInt a) * (MInt b) = MInt $ (a * b) `mod` md
    abs = id
    signum (MInt a) = MInt $ signum a
    fromInteger a = MInt $ fromInteger (a `mod` fromIntegral md)
    negate (MInt 0) = 0
    negate (MInt a) = MInt $ md - a

instance Fractional MInt where
  recip a = a ^ (md - 2)
  fromRational x =
        let a = numerator x `mod` fromIntegral md
            b = denominator x `mod` fromIntegral md
        in
            MInt (fromInteger a) / MInt (fromInteger b)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        as <- map parseInt . BS.words <$> BS.getLine
        bs <- map parseInt . BS.words <$> BS.getLine
        a <- newArray (1,n) 0 :: IO (IOArray Int Int)
        forM_ (zip as [1..]) $ \(v, i) -> do
            writeArray a v i
        let b = listArray (1,n) bs :: (Array Int Int)
        vv <- newArray (1,n) False :: IO (IOArray Int Bool)
        r <- sum <$> forM [1..n] (\i -> do
            v <- readArray vv i
            if v then
                return 0
            else do
                let iter i = do
                    v <- readArray vv i
                    if v then
                        return 0
                    else do
                        -- putStrLn $ "concha " ++ show i
                        writeArray vv i True
                        j <- readArray a i
                        r <- iter $ b ! j
                        return $ r + 1
                l <- iter i
                -- putStrLn $ "pingo " ++ show l
                return $ if l > 1 then 1 else 0
         )
        print $ (2::MInt) ^ r


YouKn0wWho has an integer sequence $$$a_1, a_2, \ldots, a_n$$$. He will perform the following operation until the sequence becomes empty: select an index $$$i$$$ such that $$$1 \le i \le |a|$$$ and $$$a_i$$$ is not divisible by $$$(i + 1)$$$, and erase this element from the sequence. Here $$$|a|$$$ is the length of sequence $$$a$$$ at the moment of operation. Note that the sequence $$$a$$$ changes and the next operation is performed on this changed sequence.For example, if $$$a=[3,5,4,5]$$$, then he can select $$$i = 2$$$, because $$$a_2 = 5$$$ is not divisible by $$$i+1 = 3$$$. After this operation the sequence is $$$[3,4,5]$$$.Help YouKn0wWho determine if it is possible to erase the whole sequence using the aforementioned operation.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$)  — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3 \cdot 10^5$$$.

For each test case, print "YES" (without quotes) if it is possible to erase the whole sequence using the aforementioned operation, print "NO" (without quotes) otherwise. You can print each letter in any register (upper or lower).

NoteIn the first test case, YouKn0wWho can perform the following operations (the erased elements are underlined): $$$[1, \underline{2}, 3] \rightarrow [\underline{1}, 3] \rightarrow [\underline{3}] \rightarrow [\,].$$$In the second test case, it is impossible to erase the sequence as $$$i$$$ can only be $$$1$$$, and when $$$i=1$$$, $$$a_1 = 2$$$ is divisible by $$$i + 1 = 2$$$.

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      peril = take 21 $ scanl1 lcm [2..]
      issue = any (\(ai, p) -> rem ai p == 0) $ zip a peril
    pure $ string7 $ if  not issue
      then  "YES\n"
      else  "NO\n"

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


A company has n employees numbered from 1 to n. Each employee either has no immediate manager or exactly one immediate manager, who is another employee with a different number. An employee A is said to be the superior of another employee B if at least one of the following is true:  Employee A is the immediate manager of employee B  Employee B has an immediate manager employee C such that employee A is the superior of employee C. The company will not have a managerial cycle. That is, there will not exist an employee who is the superior of his/her own immediate manager.Today the company is going to arrange a party. This involves dividing all n employees into several groups: every employee must belong to exactly one group. Furthermore, within any single group, there must not be two employees A and B such that A is the superior of B.What is the minimum number of groups that must be formed?

The first line contains integer n (1 ≤ n ≤ 2000) — the number of employees. The next n lines contain the integers pi (1 ≤ pi ≤ n or pi = -1). Every pi denotes the immediate manager for the i-th employee. If pi is -1, that means that the i-th employee does not have an immediate manager.  It is guaranteed, that no employee will be the immediate manager of him/herself (pi ≠ i). Also, there will be no managerial cycles.

Print a single integer denoting the minimum number of groups that will be formed in the party.

NoteFor the first example, three groups are sufficient, for example:   Employee 1  Employees 2 and 4  Employees 3 and 5

import Data.List
import qualified Data.Map as Map
import Data.Map ((!))
import Control.Monad
import Control.Applicative
import Debug.Trace

type Z = Int

traceS a b = trace (show a) b

mLength :: Map.Map Z Z -> Z -> Z
mLength hs (-1) = 0
mLength hs i = mLength hs (hs!i) + 1

main = do
  n <- read <$> getLine
  hs <- replicateM n (read <$> getLine)
  let m = Map.fromList (zip [1..] hs)
  print $ maximum (map (mLength m) [1..n])

import Data.List (partition)
import Control.Monad (foldM)
import qualified Data.IntSet as S
f l h [] = l
f l h s = let (l1, l2) = partition ((`S.member` h).snd) s in f (l+1) (S.fromList $ map fst l1) l2
main = do
    n <- read `fmap` getLine
    (h, s) <- foldM (\(h, s) i -> do
        c <- read `fmap` getLine
        return $ if c == -1 then (i `S.insert` h, s) else (h, (i, c):s)) (S.empty, []) [1..n]
    print $ f 1 h s

import Data.Array
import Data.Functor ((<$>))

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

buildArray (count : input) =
  array (1, count) $ zip [1..] input

heights arr =
  let bs@(start, end) = bounds arr
      result = array bs [(i, f i) | i <- [start..end]]
      f i =
        case (arr ! i) of
          -1 -> 1
          next -> (result ! next) + 1
  in result

main :: IO ()
main =
  do input <- readInts
     print . maximum . elems . heights $ buildArray input

module Main where

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

main = do
    n <- liftM read getLine
    parr <- liftM (listArray (1,n) . map read) (replicateM n getLine) :: IO (Array Int Int)

    let darr = listArray (1,n) $ map (\i ->
                let p = parr ! i
                in if p == -1
                    then 1
                    else 1 + darr ! p
            ) [1..n]

    --putStrLn $ show darr
    putStrLn $ show $ maximum $ elems darr

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

import Debug.Trace

depth lst i = d ! i
	where
		n = length lst - 1
		init = array (1, n) [(i, -1) | i <- [1..n]]
		d = foldl (\memo i -> depth' memo i) init [1..n]
		depth' memo i
			| memo ! i /= -1 = memo
			| lst !! i == -1 = memo // [(i, 1)]
			| otherwise = let j = lst !! i in let newmemo = depth' memo j in newmemo // [(i, newmemo ! j + 1)]

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let n = (fst . fromJust . C.readInt . head) input
	let lst = (map (fst . fromJust . C.readInt) . tail) input
	(putStrLn . show . foldl max 0) $ map (depth (0:lst)) [1..n]

import Data.Map((!),fromList)
s(n:t)=map d$[1..n]where d(-1)=0;d i=1+d(fromList(zip[1..]t)!i)
main=interact$show.maximum.s.map read.lines

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MultiWayIf           #-}
{-# LANGUAGE OverlappingInstances #-}

module Main where

import           Control.Applicative
import           Control.Category           ((>>>))
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.Graph
import qualified Data.HashMap.Lazy          as HM
import           Data.List
import           Data.Maybe
import           Data.Tree

type BString = B.ByteString

type Result = Int

solve :: Graph -> Result
solve graph = maximum [(dfs graph >>> head >>> flatten >>> length) [x] | x <- vertices graph]

construct :: [Int] -> Graph
construct xs = graph
    where (graph, _, _) = graphFromEdges [ (i, i, if x == -1 then [] else [x])
                                         | (i, x) <- zip [1..] xs]

process :: State Reader Result
process = do
    n <- parse
    nexts <- replicateM n parse
    return $ solve $ construct nexts

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    print $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

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
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. map read.(\(x:xs)-> x:take (read x) xs).lines
solve :: [Int]-> String
solve (x:xs) = show $  slv1 [-1]
  where
  zs=zip [1..] xs
  slv1 [] = -1
  slv1 xs = 1+ slv1 [z1|x<-xs,(z1,z2)<-zs,z2==x]

module Main where
import Control.Monad
import Data.Graph
import Data.Tree

main = do
    n <- readLn :: IO Int
    ps <- replicateM  n ( (\x -> if x == "-1" then 0 else read x :: Int ) <$> getLine)
    print $ pred $ length $ levels $ head $ components $ buildG (0,n) $ zip [1..] ps

import Control.Applicative ((<$>))
import Debug.Trace (trace)
import Data.Array (listArray, elems, (!))

-- 115A

solve :: [Int] -> Int
solve (n:connections) =
  maximum $ elems levels
  where
    parentArr = listArray (1, n) connections
    level v =
      let parent = parentArr ! v in
       if parent == -1 then 1 else 1 + (levels ! parent)
    levels = listArray (1, n) [level v | v <- [1..n]]

main =
  putStrLn . show . solve . map read . lines =<< getContents

{-# 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
    n <- readInt
    fa <- replicateM n readInt
    return (n, fa)
  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 (n, fa) = maximum $ map getDepth [1..n]
  where
    f = listArray (1, n) fa :: UArray Int Int

    getDepth = (cache!)
      where
        bnds = (1, n)

        cache = listArray bnds $ map go $ range bnds :: Array Int Int

        go x | f ! x == -1 = 1
             | otherwise   = getDepth (f ! x) + 1

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

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

import Control.Applicative ((<$>), (<*>))
import qualified Data.Array as A

main :: IO ()
main = print =<< solve <$> readLn <*> (map read <$> lines <$> getContents)

solve :: Integer -> [Integer] -> Integer
solve n ps = maximum $ A.elems dp
  where ps' = A.listArray (1, n) ps
        dp = A.array (1, n) [ (i, if ps' A.! i == -1 then 1 else 1 + dp A.! (ps' A.! i)) | i <- [1..n] ]

main = interact $ show . solve . map read . tail . words
solve ss = maximum hs where
  hs = map (h . pred) ss
  h (-2) = 1
  h i = 1 + hs!!i

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Data.Array.ST
import Control.Monad.ST
import Control.Monad
import Data.Array
import Data.Char
class Expression a where scan' :: String -> a; showans :: a -> String
instance Expression Int where scan' = read; showans = show
instance Expression Char where scan' (x:_) = x;showans = (:[])
instance Expression Float where scan' = read;showans = show
instance Expression Double where scan' = read;showans = show
instance Expression Integer where scan' = read;showans = show
instance Expression String where scan' = id;showans = id
instance (Expression a,Expression b) => Expression (a,b) where
    scan' = (\(x:y:_) -> (scan' x,scan' y)).words;showans (x,y) = showans x++' ':showans y
instance (Expression a,Expression b,Expression c) => Expression (a,b,c) where
    scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;showans (x,y,z) = showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d) => Expression (a,b,c,d) where
    scan' = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)).words;showans (w,x,y,z) = showans w++' ':showans x++' ':showans y++' ':showans z
instance (Expression a,Expression b,Expression c,Expression d,Expression e) => Expression (a,b,c,d,e) where
    scan' = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)).words;showans (v,w,x,y,z) = showans v++' ':showans w++' ':showans x++' ':showans y++' ':showans z
scan :: (Expression a) => IO a; scan = getLine>>=(return.scan')
scans :: (Expression a) => Int -> IO [a]; scans n = replicateM n scan
scanlist :: (Expression a) => IO [a]; scanlist = getLine>>=return.(map scan').words
scanlists :: (Expression a) => Int -> IO [[a]]; scanlists n = replicateM n scanlist
putAnsLn :: (Expression a) => a -> IO (); putAnsLn = putStrLn.showans
putAnsLns :: (Expression a) => [a] -> IO (); putAnsLns = mapM_ putAnsLn

solve :: Int -> [Int] -> Int
solve n l = maximum $ map (dfs.fst) employers
    where
      dfs v = case inferior!v of
                [] -> 1
                inf -> (+1) $ maximum $ map dfs inf
      (employers,employees) = partition ((-1==).snd) (zip [1..n] l)
      inferior = runSTArray $ do
                   ary <- newArray (1,n) []
                   mapM_ (\(i,sp) -> do {l <- readArray ary sp;writeArray ary sp (i:l)}) employees
                   return ary

main = do n <- scan :: IO Int
          l <- scans n ::IO [Int]
          print $ solve n l

import Data.List
import Control.Applicative
import qualified Data.Map as Map
import Data.Map((!))

p(-1)=Nothing
p n=Just n
d m(-1)=0
d m i=d m(m!i)+1
s' n m=maximum$map(d m)[1..n]
s(n:t)=s' n$Map.fromList(zip[1..]t)

main=interact$show.s.map read.lines

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

leng as a | a== (-1) = 1
          | otherwise = 1+ leng as (as!a)

main = do
		n<-read <$> getLine ::IO Int
		s<-map read <$> replicateM n getLine ::IO [Int]
		let as = listArray (1,length s) s
		print $ maximum $ map (leng as) s

import Data.Array (listArray, (!), indices)

process :: [Int] -> Int
process ps = maximum heights
    where
        n = length ps
        ps' = listArray (1,n) ps
        heights = listArray (1,n) [height i | i <- indices ps']
        height i
            | p == -1 = 1
            | otherwise = 1 + (heights ! p)
            where p = ps' ! i

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    ps <- fmap (map readInt.words) getContents
    print $ process ps

{-# OPTIONS -O2 #-}
main = do
  s <- getContents
  let (n:nums) = map read $ words s :: [Int]
  print $ solve [i|i<-[1..n], nums !! (i-1) == -1] [(i, j)|(i, j)<- zip [1..] nums, j /= -1]

solve :: [Int] -> [(Int, Int)] -> Int
solve _ [] = 1
solve poss left = 1 + solve x y
  where
    x = [pos | (pos, i) <- left, elem i poss]
    y = [(pos, i) | (pos, i) <- left, notElem pos x]

import Data.Tree (drawTree, levels)
import Data.Graph (buildG, vertices, components)
import Control.Applicative ((<$>))
import Debug.Trace (trace)

-- 115A

solve :: [Int] -> Int
solve (n:connections) =
  comps
  where
    track q = trace (show q) q
    edges = filter (\x -> snd x > 0) $ zip [1..] connections
    graph = buildG (1,n) edges
    comps = maximum $ map (length . levels) $ components graph

main =
  putStrLn . show . solve . map read . lines =<< getContents

import Data.Graph

main = do
  putStrLn $ show $ buildG (1,3) [(2,3)]

{-# OPTIONS -O2 #-}
main = do
  s <- getContents
  let (n:nums) = map read $ words s :: [Int]
  print $ solve [i|i<-[1..n], nums !! (i-1) == -1] [(i, j)|(i, j)<- zip [1..] nums, j /= -1]

solve _ [] = 1
solve poss left = 1 + solve x y
  where
    x = [pos | (pos, i) <- left, elem i poss]
    y = [(pos, i) | (pos, i) <- left, elem pos x]

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

type Z = Integer

mLength hs x
  | (!!) hs x == -1 = 1
  | otherwise = 1 + mLength hs ((hs !! x) - 1)

main = do
  n <- read <$> getLine
  hs <- replicateM n (read <$> getLine)
  return $ maximum (map (mLength hs) [0..(length hs)-1])


You are given a functional graph. It is a directed graph, in which from each vertex goes exactly one arc. The vertices are numerated from 0 to n - 1.Graph is given as the array f0, f1, ..., fn - 1, where fi — the number of vertex to which goes the only arc from the vertex i. Besides you are given array with weights of the arcs w0, w1, ..., wn - 1, where wi — the arc weight from i to fi.    The graph from the first sample test. Also you are given the integer k (the length of the path) and you need to find for each vertex two numbers si and mi, where:  si — the sum of the weights of all arcs of the path with length equals to k which starts from the vertex i;  mi — the minimal weight from all arcs on the path with length k which starts from the vertex i. The length of the path is the number of arcs on this path.

The first line contains two integers n, k (1 ≤ n ≤ 105, 1 ≤ k ≤ 1010). The second line contains the sequence f0, f1, ..., fn - 1 (0 ≤ fi < n) and the third — the sequence w0, w1, ..., wn - 1 (0 ≤ wi ≤ 108).

Print n lines, the pair of integers si, mi in each line.

-- ID:  702E (Analysis of Pathes in Functional Graph)
-- URL: http://codeforces.com/contest/702/problem/E

{-# LANGUAGE BangPatterns #-}

import System.IO

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.Char
import Numeric
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Control.Exception
import Control.DeepSeq

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

data Node = Node !Int !Int64 !Int64 -- (to, cost, minWeight)
instance NFData Node where
    rnf (Node !a !b !c) = rnf a `seq` rnf b `seq` rnf c
type State = Array Int Node

toBinary :: Int64 -> String
toBinary x = showIntAtBase 2 intToDigit x ""

valid (state, digit) = digit == '1'

main = do
    [n', k'] <- words `fmap` getLine
    let n = read n' :: Int
    let k = read k' :: Int64
    let pos = toBinary k
    evaluate pos
    nexts <- listArray (0,n-1) `fmap` getInts :: IO (Array Int Int)
    costs <- listArray (0,n-1) `fmap` getInt64s :: IO (Array Int Int64)
    let state0 = initState n nexts costs
    let states = scanl (step n) state0 [1..length pos]
    let valids = fst $ unzip $ filter valid (zip states (reverse pos))
    let soln = findSoln valids n
    --hPutStrLn stderr "start calc"
    evaluate $ force states
    evaluate $ force valids
    evaluate $ force soln
    --hPutStrLn stderr "calc done"
    forM_ [0..n-1] $ \i -> do
        let Node _ !si !mi = soln ! i
        putStr (show si)
        putChar ' '
        putStrLn (show mi)
    --hPutStrLn stderr "print done"

-- num nodes, next nodes, edge weights -> initial iteration (state after very first move)
initState :: Int -> Array Int Int -> Array Int Int64 -> State
initState n nexts costs = listArray (0,n-1) [Node (nexts ! i) cost cost | i <- [0..n-1], let cost = costs ! i]

step :: Int -> State -> Int -> State
step n state _ = listArray (0,n-1) [f i | i <- [0..n-1]] where
    f i = Node to2 (len1+len2) (min min1 min2) where
        Node !to1 !len1 !min1 = state ! i
        Node !to2 !len2 !min2 = state ! to1

findSoln :: [State] -> Int -> Array Int Node
findSoln states n = f states $ listArray (0,n-1) [Node i 0 (10^8+1) | i <- [0..n-1]] where
    f [] soln = soln
    f (st:states) curr = f states $
        listArray (0,n-1) [Node to1 (s+len1) (min m min1) | i <- [0..n-1],
                            let Node !to !s !m = curr ! i,
                            let Node !to1 !len1 !min1 = st ! to]

-- ID:  702E (Analysis of Pathes in Functional Graph)
-- URL: http://codeforces.com/contest/702/problem/E

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.Char
import Numeric
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Control.Exception
import Control.DeepSeq

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

data Node = Node {-# UNPACK #-} !Int {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64 -- (to, cost, minWeight)
instance NFData Node where
    rnf (Node a b c) = rnf a `seq` rnf b `seq` rnf c
type State = Array Int Node

toBinary :: Int64 -> String
toBinary x = showIntAtBase 2 intToDigit x ""

valid (state, digit) = digit == '1'

main = do
    [n', k'] <- words `fmap` getLine
    let n = read n' :: Int
    let k = read k' :: Int64
    let pos = toBinary k
    evaluate pos
    nexts <- listArray (0,n-1) `fmap` getInts :: IO (Array Int Int)
    costs <- listArray (0,n-1) `fmap` getInt64s :: IO (Array Int Int64)
    let state0 = initState n nexts costs
    let states = scanl (step n) state0 [1..length pos-1]
    let valids = fst $ unzip $ filter valid (zip states (reverse pos))
    let soln = findSoln valids n
    evaluate $ force states
    evaluate $ force valids
    evaluate $ force soln
    forM_ [0..n-1] $ \i -> do
        let Node _ !si !mi = soln ! i
        putStr (show si)
        putChar ' '
        putStrLn (show mi)

-- num nodes, next nodes, edge weights -> initial iteration (state after very first move)
initState :: Int -> Array Int Int -> Array Int Int64 -> State
initState n nexts costs = listArray (0,n-1) [Node (nexts ! i) cost cost | i <- [0..n-1], let cost = costs ! i]

step :: Int -> State -> Int -> State
step n state _ = listArray (0,n-1) [f i | i <- [0..n-1]] where
    f i = Node to2 (len1+len2) (min min1 min2) where
        Node to1 len1 min1 = state ! i
        Node to2 len2 min2 = state ! to1

findSoln :: [State] -> Int -> Array Int Node
findSoln states n = f states $ listArray (0,n-1) [Node i 0 (10^8+1) | i <- [0..n-1]] where
    f [] soln = soln
    f (st:states) curr = f states $
        listArray (0,n-1) [Node to1 (s+len1) (min m min1) | i <- [0..n-1],
                            let Node to s m = curr ! i,
                            let Node to1 len1 min1 = st ! to]

-- ID:  702E (Analysis of Pathes in Functional Graph)
-- URL: http://codeforces.com/contest/702/problem/E

{-# LANGUAGE BangPatterns #-}

import System.IO

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.Char
import Numeric
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Control.Exception
import Control.DeepSeq

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

data Node = Node !Int !Int64 !Int64 -- (to, cost, minWeight)
instance NFData Node where
    rnf (Node a b c) = rnf a `seq` rnf b `seq` rnf c
type State = Array Int Node

toBinary :: Int64 -> String
toBinary x = showIntAtBase 2 intToDigit x ""

valid (state, digit) = digit == '1'

main = do
    [n', k'] <- words `fmap` getLine
    let n = read n' :: Int
    let k = read k' :: Int64
    let pos = toBinary k
    evaluate pos
    nexts <- listArray (0,n-1) `fmap` getInts :: IO (Array Int Int)
    costs <- listArray (0,n-1) `fmap` getInt64s :: IO (Array Int Int64)
    let state0 = initState n nexts costs
    let states = scanl (step n) state0 [1..length pos]
    let valids = fst $ unzip $ filter valid (zip states (reverse pos))
    let soln = findSoln valids n
    --hPutStrLn stderr "start calc"
    evaluate $ force states
    evaluate $ force valids
    evaluate $ force soln
    --hPutStrLn stderr "calc done"
    forM_ [0..n-1] $ \i -> do
        let Node _ !si !mi = soln ! i
        putStr (show si)
        putChar ' '
        putStrLn (show mi)
    --hPutStrLn stderr "print done"

-- num nodes, next nodes, edge weights -> initial iteration (state after very first move)
initState :: Int -> Array Int Int -> Array Int Int64 -> State
initState n nexts costs = listArray (0,n-1) [Node (nexts ! i) cost cost | i <- [0..n-1], let cost = costs ! i]

step :: Int -> State -> Int -> State
step n state _ = listArray (0,n-1) [f i | i <- [0..n-1]] where
    f i = Node to2 (len1+len2) (min min1 min2) where
        Node to1 len1 min1 = state ! i
        Node to2 len2 min2 = state ! to1

findSoln :: [State] -> Int -> Array Int Node
findSoln states n = f states $ listArray (0,n-1) [Node i 0 (10^8+1) | i <- [0..n-1]] where
    f [] soln = soln
    f (st:states) curr = f states $
        listArray (0,n-1) [Node to1 (s+len1) (min m min1) | i <- [0..n-1],
                            let Node to s m = curr ! i,
                            let Node to1 len1 min1 = st ! to]

-- ID:  702E (Analysis of Pathes in Functional Graph)
-- URL: http://codeforces.com/contest/702/problem/E

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.Char
import Numeric
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Control.Exception
import Control.DeepSeq

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

data Node = Node !Int !Int64 !Int64 -- (to, cost, minWeight)
instance NFData Node where
    rnf (Node a b c) = rnf a `seq` rnf b `seq` rnf c
type State = Array Int Node

toBinary :: Int64 -> String
toBinary x = showIntAtBase 2 intToDigit x ""

valid (state, digit) = digit == '1'

main = do
    [n', k'] <- words `fmap` getLine
    let n = read n' :: Int
    let k = read k' :: Int64
    let pos = toBinary k
    evaluate pos
    nexts <- listArray (0,n-1) `fmap` getInts :: IO (Array Int Int)
    costs <- listArray (0,n-1) `fmap` getInt64s :: IO (Array Int Int64)
    let state0 = initState n nexts costs
    let states = scanl (step n) state0 [1..length pos-1]
    let valids = fst $ unzip $ filter valid (zip states (reverse pos))
    let soln = findSoln valids n
    evaluate $ force states
    evaluate $ force valids
    evaluate $ force soln
    forM_ [0..n-1] $ \i -> do
        let Node _ !si !mi = soln ! i
        putStr (show si)
        putChar ' '
        putStrLn (show mi)

-- num nodes, next nodes, edge weights -> initial iteration (state after very first move)
initState :: Int -> Array Int Int -> Array Int Int64 -> State
initState n nexts costs = listArray (0,n-1) [Node (nexts ! i) cost cost | i <- [0..n-1], let cost = costs ! i]

step :: Int -> State -> Int -> State
step n state _ = listArray (0,n-1) [f i | i <- [0..n-1]] where
    f i = Node to2 (len1+len2) (min min1 min2) where
        Node to1 len1 min1 = state ! i
        Node to2 len2 min2 = state ! to1

findSoln :: [State] -> Int -> Array Int Node
findSoln states n = f states $ listArray (0,n-1) [Node i 0 (10^8+1) | i <- [0..n-1]] where
    f [] soln = soln
    f (st:states) curr = f states $
        listArray (0,n-1) [Node to1 (s+len1) (min m min1) | i <- [0..n-1],
                            let Node to s m = curr ! i,
                            let Node to1 len1 min1 = st ! to]

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

readInts :: Integral a => IO [a]
readInts = map (fromIntegral . fst . fromJust . BS.readInt) . BS.words <$> BS.getLine

main = do
    [n, k] <- map read . words <$> getLine :: IO [Int64]
    fs <- readInts
    ws <- readInts
    let vecs :: [(UArray Int Int, UArray Int Int64, UArray Int Int64)]
        vecs = iterate (\(a, b, c) -> (array (0, n') [(i, a ! (a ! i)) | i <- [0 .. n']], array (0, n') [(i, b ! (a ! i) + b ! i) | i <- [0 .. n']], array (0, n') [(i, min (c ! (a ! i)) (c ! i)) | i <- [0 .. n']])) $ let f = listArray (0, n') in (listArray (0, n') fs, f ws, f ws)
        ans h ((a, b, c) : vs) i acc@(accb, accc)
            | odd h = ans (h `quot` 2) vs (a ! i) $ ((b ! i) + accb, min accc $ c ! i)
            | h == 0 = acc
            | otherwise = ans (h `quot` 2) vs i acc
        n' = fromIntegral n - 1 :: Int
    sequence_ [putStrLn . (\(y, z) -> (show y) ++ " " ++ (show z)) $ ans k vecs i (0, 10 ^ 9) | i <- [0 .. n']]

import Data.Array.Unboxed
import Data.Maybe
import Data.Int
import qualified Data.ByteString.Char8 as BS

readInts :: Integral a => IO [a]
readInts = (map (fromIntegral . fst . fromJust . BS.readInt) . BS.words) `fmap` BS.getLine

main = do
    [n, k] <- (map read . words) `fmap` getLine :: IO [Int64]
    fs <- readInts
    ws <- readInts
    let vecs :: [(UArray Int Int, UArray Int Int64, UArray Int Int64)]
        vecs =
            iterate
                ( \(a, b, c) ->
                    ( array (0, n') [(i, a ! (a ! i)) | i <- [0 .. n']]
                    , array (0, n') [(i, b ! (a ! i) + b ! i) | i <- [0 .. n']]
                    , array (0, n') [(i, min (c ! (a ! i)) (c ! i)) | i <- [0 .. n']]))
            $ (listArray (0, n') fs, listArray (0, n') ws, listArray (0, n') ws)
        ans h ((a, b, c) : vs) i (accb, accc)
            | odd h = ans (h `quot` 2) vs (a ! i) $ ((b ! i) + accb, min accc $ c ! i)
            | h == 0 = show accb ++ " " ++ show accc
            | otherwise = ans (h `quot` 2) vs i (accb, accc)
        n' = fromIntegral n - 1 :: Int
    mapM_ putStrLn [ans k vecs i (0, 10 ^ 9) | i <- [0 .. n']]

{-# LANGUAGE FlexibleInstances #-}

import Data.Array.Unboxed
import Data.Maybe
import Data.Int
import qualified Data.ByteString.Char8 as BS

type Vec = (UArray Int Int, UArray Int Int64, UArray Int Int64)

instance Num Vec where
    (a1, b1, c1) * (a2, b2, c2) = (listArray x [a1 ! (a2 ! i) | i <- [0 .. n']], listArray x [(b1 ! (a2 ! i)) + (b2 ! i) | i <- [0 .. n']], listArray x [min (c1 ! (a2 ! i)) (c2 ! i) | i <- [0 .. n']])
        where
            x@(_, n') = bounds a1

readInts :: Integral a => IO [a]
readInts = (map (fromIntegral . fst . fromJust . BS.readInt) . BS.words) `fmap` BS.getLine

main = do
    [n, k] <- (map read . words) `fmap` getLine :: IO [Int64]
    fs <- readInts
    ws <- readInts
    let (_, b, c) = ((listArray x fs, listArray x ws, listArray x ws) :: Vec) ^ k
        x = (0, fromIntegral $ n - 1 :: Int)
    mapM_ putStrLn [show y ++ " " ++ show z | (y, z) <- zip (elems b) (elems c)]

-- ID:  702E (Analysis of Pathes in Functional Graph)
-- URL: http://codeforces.com/contest/702/problem/E

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.Char
import Numeric
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Control.Exception
import Control.DeepSeq
import System.IO

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
getInt64s = (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) `fmap` BS.getLine :: IO [Int64]

data Node = Node !Int !Int64 !Int64 -- (to, cost, minWeight)
instance NFData Node where
    rnf (Node a b c) = rnf a `seq` rnf b `seq` rnf c
type State = Array Int Node

toBinary :: Int64 -> String
toBinary x = showIntAtBase 2 intToDigit x ""

valid (state, digit) = digit == '1'

main = do
    [n', k'] <- words `fmap` getLine
    let n = read n' :: Int
    let k = read k' :: Int64
    let pos = toBinary k
    evaluate pos
    nexts <- listArray (0,n-1) `fmap` getInts :: IO (Array Int Int)
    costs <- listArray (0,n-1) `fmap` getInt64s :: IO (Array Int Int64)
    let state0 = initState n nexts costs
    let states = scanl (step n) state0 [1..length pos]
    let valids = fst $ unzip $ filter valid (zip states (reverse pos))
    let soln = findSoln valids n
    --hPutStrLn stderr "start calc"
    evaluate $ force states
    evaluate $ force valids
    evaluate $ force soln
    --hPutStrLn stderr "calc done"
    forM_ [0..n-1] $ \i -> do
        let Node _ si mi = soln ! i
        putStr (show si)
        putChar ' '
        putStrLn (show mi)
    --hPutStrLn stderr "print done"

-- num nodes, next nodes, edge weights -> initial iteration (state after very first move)
initState :: Int -> Array Int Int -> Array Int Int64 -> State
initState n nexts costs = listArray (0,n-1) [Node (nexts ! i) cost cost | i <- [0..n-1], let cost = costs ! i]

step :: Int -> State -> Int -> State
step n state _ = listArray (0,n-1) [f i | i <- [0..n-1]] where
    f i = Node to2 (len1+len2) (min min1 min2) where
        Node to1 len1 min1 = state ! i
        Node to2 len2 min2 = state ! to1

findSoln :: [State] -> Int -> Array Int Node
findSoln states n = f states $ listArray (0,n-1) [Node i 0 (10^8+1) | i <- [0..n-1]] where
    f [] soln = soln
    f (st:states) curr = f states $
        listArray (0,n-1) [Node to1 (s+len1) (min m min1) | i <- [0..n-1],
                            let Node to s m = curr ! i,
                            let Node to1 len1 min1 = st ! to]

{-# LANGUAGE FlexibleContexts #-}

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

readInts :: Integral a => IO [a]
readInts = map (fromIntegral . fst . fromJust . BS.readInt) . BS.words <$> BS.getLine

main = do
    [n, k] <- readInts
    fs <- readInts
    ws <- readInts :: IO [Word64]
    let mkArray :: (a -> a -> a) -> [a] -> Array (Int, Int) a
        mkArray f l = let a = array ((0, 0), (34, n - 1)) $ zip (zip (repeat 0) [0 ..]) l ++ [((j, i), (a ! (j - 1, jump ! (j - 1, i))) `f` (a ! (j - 1, i))) | j <- [1 .. 34], i <- [0 .. n - 1]] in a
        jump = mkArray const fs
        sjump = mkArray (+) ws
        mjump = mkArray min ws
        ans f h j i arr acc
            | h == 0 = acc
            | even h = ans f (h `quot` 2) (j + 1) i arr acc
            | otherwise = ans f (h `quot` 2) (j + 1) (jump ! (j, i)) arr $ acc `f` (arr ! (j, i))
    sequence_ [putStrLn . unwords $ map show [ans (+) (fromIntegral k :: Word64) 0 i sjump 0, ans min (fromIntegral k :: Word64) 0 i mjump (10 ^ 9)] | i <- [0 .. n - 1]]

{-# LANGUAGE FlexibleContexts #-}

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

readInts :: Integral a => IO [a]
readInts = map (fromIntegral . fst . fromJust . BS.readInt) . BS.words <$> BS.getLine

main = do
    [n, k] <- readInts :: IO [Int64]
    fs <- readInts
    ws <- readInts :: IO [Int64]
    let mkArray :: (a -> a -> a) -> [a] -> Array (Int, Int) a
        mkArray f l = let a = array ((0, 0), (34, n')) $ zip (zip (repeat 0) [0 ..]) l ++ [((j, i), (a ! (j - 1, jump ! (j - 1, i))) `f` (a ! (j - 1, i))) | j <- [1 .. 34], i <- [0 .. n']] in a
        jump = mkArray const fs
        sjump = mkArray (+) ws
        mjump = mkArray min ws
        ans f h j i arr acc
            | h == 0 = acc
            | even h = ans f (h `quot` 2) (j + 1) i arr acc
            | otherwise = ans f (h `quot` 2) (j + 1) (jump ! (j, i)) arr $ acc `f` (arr ! (j, i))
        n' = fromIntegral $ n - 1 :: Int
    sequence_ [putStrLn . unwords $ map show [ans (+) k 0 i sjump 0, ans min k 0 i mjump (10 ^ 9)] | i <- [0 .. n']]

import Data.Array.Unboxed
import Data.Maybe
import Data.Int
import qualified Data.ByteString.Char8 as BS

readInts :: Integral a => IO [a]
readInts = (map (fromIntegral . fst . fromJust . BS.readInt) . BS.words) `fmap` BS.getLine

main = do
    [n, k] <- readInts :: IO [Int64]
    fs <- readInts
    ws <- readInts
    let vecs :: [(UArray Int Int, UArray Int Int64, UArray Int Int64)]
        vecs =
            iterate
                ( \(a, b, c) ->
                    ( array (0, n') [(i, a ! (a ! i)) | i <- [0 .. n']]
                    , array (0, n') [(i, b ! (a ! i) + b ! i) | i <- [0 .. n']]
                    , array (0, n') [(i, min (c ! (a ! i)) (c ! i)) | i <- [0 .. n']]))
            $ (listArray (0, n') fs, listArray (0, n') ws, listArray (0, n') ws)
        ans h ((a, b, c) : vs) i (accb, accc)
            | odd h = ans (h `quot` 2) vs (a ! i) $ ((b ! i) + accb, min accc $ c ! i)
            | h == 0 = show accb ++ " " ++ show accc
            | otherwise = ans (h `quot` 2) vs i (accb, accc)
        n' = fromIntegral n - 1 :: Int
    mapM_ putStrLn [ans k vecs i (0, 10 ^ 9) | i <- [0 .. n']]

{-# LANGUAGE FlexibleContexts #-}

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

readInts :: Integral a => IO [a]
readInts = map (fromIntegral . fst . fromJust . BS.readInt) . BS.words <$> BS.getLine

main = do
    [n, k] <- readInts :: IO [Word64]
    fs <- readInts
    ws <- readInts :: IO [Word64]
    let mkArray :: (a -> a -> a) -> [a] -> Array (Int, Int) a
        mkArray f l = let a = array ((0, 0), (34, n')) $ zip (zip (repeat 0) [0 ..]) l ++ [((j, i), (a ! (j - 1, jump ! (j - 1, i))) `f` (a ! (j - 1, i))) | j <- [1 .. 34], i <- [0 .. n']] in a
        jump = mkArray const fs
        sjump = mkArray (+) ws
        mjump = mkArray min ws
        ans f h j i arr acc
            | h == 0 = acc
            | even h = ans f (h `quot` 2) (j + 1) i arr acc
            | otherwise = ans f (h `quot` 2) (j + 1) (jump ! (j, i)) arr $ acc `f` (arr ! (j, i))
        n' = fromIntegral $ n - 1 :: Int
    sequence_ [putStrLn . unwords $ map show [ans (+) k 0 i sjump 0, ans min k 0 i mjump (10 ^ 9)] | i <- [0 .. n']]

{-# LANGUAGE FlexibleContexts #-}

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

readInts :: Integral a => IO [a]
readInts = map (fromIntegral . fst . fromJust . BS.readInt) . BS.words <$> BS.getLine

main = do
    [n, k] <- readInts
    fs <- readInts
    ws <- readInts :: IO [Word64]
    let mkArray :: (a -> a -> a) -> [a] -> Array (Int, Int) a
        mkArray f l = let a = array ((0, 0), (34, n - 1)) $ zip (zip (repeat 0) [0 ..]) l ++ [((j, i), (a ! (j - 1, jump ! (j - 1, i))) `f` (a ! (j - 1, i))) | j <- [1 .. 34], i <- [0 .. n - 1]] in a
        jump = mkArray const fs
        sjump = mkArray (+) ws
        mjump = mkArray min ws
        ans f h j i arr acc
            | h == 0 = acc
            | even h = ans f (h `quot` 2) (j + 1) i arr acc
            | otherwise = ans f (h `quot` 2) (j + 1) (jump ! (j, i)) arr $ acc `f` (arr ! (j, i))
    sequence_ [putStrLn . unwords $ map show [ans (+) k 0 i sjump 0, ans min k 0 i mjump (10 ^ 9)] | i <- [0 .. n - 1]]


Let $$$f(i)$$$ denote the minimum positive integer $$$x$$$ such that $$$x$$$ is not a divisor of $$$i$$$.Compute $$$\sum_{i=1}^n f(i)$$$ modulo $$$10^9+7$$$. In other words, compute $$$f(1)+f(2)+\dots+f(n)$$$ modulo $$$10^9+7$$$.

The first line contains a single integer $$$t$$$ ($$$1\leq t\leq 10^4$$$), the number of test cases. Then $$$t$$$ cases follow. The only line of each test case contains a single integer $$$n$$$ ($$$1\leq n\leq 10^{16}$$$).

For each test case, output a single integer $$$ans$$$, where $$$ans=\sum_{i=1}^n f(i)$$$ modulo $$$10^9+7$$$.

NoteIn the fourth test case $$$n=4$$$, so $$$ans=f(1)+f(2)+f(3)+f(4)$$$.  $$$1$$$ is a divisor of $$$1$$$ but $$$2$$$ isn't, so $$$2$$$ is the minimum positive integer that isn't a divisor of $$$1$$$. Thus, $$$f(1)=2$$$.  $$$1$$$ and $$$2$$$ are divisors of $$$2$$$ but $$$3$$$ isn't, so $$$3$$$ is the minimum positive integer that isn't a divisor of $$$2$$$. Thus, $$$f(2)=3$$$.  $$$1$$$ is a divisor of $$$3$$$ but $$$2$$$ isn't, so $$$2$$$ is the minimum positive integer that isn't a divisor of $$$3$$$. Thus, $$$f(3)=2$$$.  $$$1$$$ and $$$2$$$ are divisors of $$$4$$$ but $$$3$$$ isn't, so $$$3$$$ is the minimum positive integer that isn't a divisor of $$$4$$$. Thus, $$$f(4)=3$$$. Therefore, $$$ans=f(1)+f(2)+f(3)+f(4)=2+3+2+3=10$$$.

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Monad       (replicateM_)
import Data.Array.Unboxed  (UArray, elems, listArray)
import Data.List           (foldl')
import Data.Word           (Word8, Word32, Word64)

ds :: UArray Int Word64
ds = listArray (0, 19) [1,2,6,12,60,420,840,2520,27720,360360,720720,12252240,232792560,5354228880,26771144400,80313433200,2329089562800,72201776446800,144403552893600,5342931457063200]

ms :: UArray Int Word8
ms = listArray (0, 19) [2,1,1,1,2,1,1,2,2,3,1,2,4,2,2,2,2,1,5,4]

s :: Word64 -> Word32
s !x = fromIntegral . (`rem` 1000000007) . foldl' (+) 0 . zipWith (\ d m -> (x `quot` d) * fromIntegral m) (elems ds) $ elems ms

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Monad  (replicateM_)
import Data.Bits      (unsafeShiftL, unsafeShiftR)
import Data.Word      (Word32, Word64)

s :: Word64 -> Word32
s !x = let !term01 = 2*(x `quot` 1)
           !term02 = term01 + 1*(x `quot` 2)
           !term03 = term02 + 1*(x `quot` 6)
           !term04 = term03 + 1*(x `quot` 12)
           !term05 = term04 + 2*(x `quot` 60)
           !term06 = term05 + 1*(x `quot` 420)
           !term07 = term06 + 1*(x `quot` 840)
           !term08 = term07 + 2*(x `quot` 2520)
           !term09 = term08 + 2*(x `quot` 27720)
           !term10 = term09 + 3*(x `quot` 360360)
           !term11 = term10 + 1*(x `quot` 720720)
           !term12 = term11 + 2*(x `quot` 12252240)
           !term13 = term12 + 4*(x `quot` 232792560)
           !term14 = term13 + 2*(x `quot` 5354228880)
           !term15 = term14 + 2*(x `quot` 26771144400)
           !term16 = term15 + 2*(x `quot` 80313433200)
           !term17 = term16 + 2*(x `quot` 2329089562800)
           !term18 = term17 + 1*(x `quot` 72201776446800)
           !term19 = term18 + 5*(x `quot` 144403552893600)
           !term20 = term19 + 4*(x `quot` 5342931457063200)
           !result = fromIntegral (term20 `rem` 1000000007)
       in  result

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Monad  (replicateM_)
import Data.Bits      (unsafeShiftL, unsafeShiftR)
import Data.Word      (Word32, Word64)

s :: Word64 -> Word32
s !x = let !quot02 = unsafeShiftR x 1
           !quot03 = x `quot` 6
           !quot04 = unsafeShiftR quot03 1
           !quot05 = x `quot` 60
           !quot06 = x `quot` 420
           !quot07 = unsafeShiftR quot06 1
           !quot08 = x `quot` 2520
           !quot09 = x `quot` 27720
           !quot10 = x `quot` 360360
           !quot11 = unsafeShiftR quot10 1
           !quot12 = x `quot` 12252240
           !quot13 = x `quot` 232792560
           !quot14 = x `quot` 5354228880
           !quot15 = x `quot` 26771144400
           !quot16 = x `quot` 80313433200
           !quot17 = x `quot` 2329089562800
           !quot18 = x `quot` 72201776446800
           !quot19 = unsafeShiftR quot18 1
           !quot20 = x `quot` 5342931457063200
           !term01 = x + x
           !term02 = term01 + quot02
           !term03 = term02 + quot03
           !term04 = term03 + quot04
           !term05 = term04 + quot05 + quot05
           !term06 = term05 + quot06
           !term07 = term06 + quot07
           !term08 = term07 + quot08 + quot08
           !term09 = term08 + quot09 + quot09
           !term10 = term09 + quot10 + quot10 + quot10
           !term11 = term10 + quot11
           !term12 = term11 + quot12 + quot12
           !term13 = term12 + unsafeShiftL quot13 2
           !term14 = term13 + quot14 + quot14
           !term15 = term14 + quot15 + quot15
           !term16 = term15 + quot16 + quot16
           !term17 = term16 + quot17 + quot17
           !term18 = term17 + quot18
           !term19 = term18 + unsafeShiftL quot19 2 + quot19
           !term20 = term19 + unsafeShiftL quot20 2
           !result = fromIntegral (term20 `rem` 1000000007)
       in  result

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Arrow       ((&&&))
import Control.Monad       (replicateM_)
import Data.Array.Unboxed  (UArray, (!), listArray)
import Data.List           (group, scanl')
import Data.Word           (Word8, Word32, Word64)

lcmsWithWidths :: [(Word8, Word64)]
lcmsWithWidths = map (fromIntegral . length &&& head) . group . scanl' lcm 1 $ [1 ..]

widths :: UArray Word8 Word8
widths = listArray (0, 19) . map fst $ lcmsWithWidths

lcms :: UArray Word8 Word64
lcms = listArray (0, 19) . map snd $ lcmsWithWidths

s :: Word64 -> Word32
s = go 0 0
  where
    go :: Word8 -> Word64 -> Word64 -> Word32
    go !20 !sum _  = fromIntegral $ sum `rem` 1000000007
    go !i  !sum !x = go (i + 1) (sum + fromIntegral (widths ! i)*(x `quot` (lcms ! i))) x

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Monad       (replicateM_)
import Data.Array.Unboxed  (UArray, (!), listArray)
import Data.List           (scanl')
import Data.Word           (Word8, Word32, Word64)

lcms :: UArray Word8 Word64
lcms = listArray (0, 40) . scanl' lcm 1 $ [1 ..]

s :: Word64 -> Word32
s = go 0 0
  where
    go :: Word8 -> Word64 -> Word64 -> Word32
    go !41 !sum _  = fromIntegral $ sum `rem` 1000000007
    go !i  !sum !x = go (i + 1) (sum + x `quot` (lcms ! i)) x

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

module Main  (main) where

import Control.Monad  (replicateM_)
import Data.Word      (Word8, Word32, Word64)

s :: Word64 -> Word32
s x = go 3 0 1 2 0 x
  where
    go ::  Word8 -> Word32 -> Word64 -> Word64 -> Word64 -> Word64 -> Word32
    go !n !sum !lcm1 !lcm2 !handled !x
      | handled == x = sum
      | lcm1 == lcm2 = go (n + 1) sum lcm1 (lcm lcm2 (fromIntegral n)) handled x
      | otherwise    = let !itemsPerGroup = (lcm2 `quot` lcm1) - 1
                           (!fullGroups, !remainder) = x `quotRem` lcm2
                           !count = itemsPerGroup*fullGroups + remainder `quot` lcm1
                       in  go (n + 1) (fromIntegral ((fromIntegral sum + (fromIntegral (n - 1))*count) `rem` 1000000007)) lcm2 (lcm lcm2 (fromIntegral n)) (handled + count) x

main :: IO ()
main = do
  count <- fmap read getLine
  replicateM_ count $ do
    x <- fmap read getLine
    print (s x)

{-# LANGUAGE BangPatterns #-}

import Control.Monad

answerFix x n
  | producted > n = 0
  | otherwise = (n `div` producted) + answerFix (x + 1) n
  where
    !producted = foldl1 lcm [1..x]

answer n
  | odd n  =  (`mod` (7 + (10 ^ 9))) $ (fixed +) $ (n' + 1) * 2 + n' * 3
  | even n =  (`mod` (7 + (10 ^ 9))) $ (fixed +) $ n' * 2 + n' * 3
  where
      n' = n `div` 2
      fixed = answerFix 3 n

readInt :: String -> Integer
readInt = read

main = do
  n <- readInt <$> getLine
  replicateM_ (fromIntegral n) $ do
    m <- readInt <$> getLine
    print $ answer m

import Control.Monad (replicateM_)

md = 10^9 + 7 :: Integer
mx = 41

modPlus a b = (a `rem` md + b `rem` md) `rem` md

modProd a b = (a `rem` md * b `rem` md) `rem` md

compute :: Integer -> Integer
compute n = foldr1 modPlus mults where
  lcms = scanl1 lcm [1..mx]
  g i prev curr = i `modProd` (n `div` prev - n `div` curr)
  mults = zipWith3 g [2..] lcms (tail lcms)

solve :: IO ()
solve = do
  n <- readLn
  print $ compute n

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

factors :: Int64 -> Int64 -> [Int64]
factors 1 _ = []
factors x start
  | start*start > x = [x]
  | mod x start == 0 = start : factors (div x start) start
  | otherwise = factors x (start+1)

thisIsSmallest n lcmm i
  | rem lcmm i == 0 = 0
  | otherwise = div n lcmm - div n (lcm lcmm i)

solve = do
  n <- readLn :: IO Int64
  let mx = 1000000007
      lcms = takeWhile (<=n+1) $ scanl lcm 1 [2..]
      resl = map (\(i, lcmm) -> thisIsSmallest n lcmm i) $ zip [2..] lcms
      res = foldl (\acc (idx, x) -> rem (acc + idx*x) mx) 0 $ zip [2..] resl
    in putStrLn $ show res

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

import Control.Arrow ((>>>))

main :: IO ()
main = interact $ words >>> drop 1 >>> map (read >>> solve >>> show) >>> unlines

solve :: Integer -> Integer
solve n =
  (`mod` (10 ^ 9 + 7))
    . (n +)
    . sum
    . map (n `div`)
    . takeWhile (<= n)
    $ scanl1 lcm [1 ..]

{-# LANGUAGE BangPatterns #-}

import Control.Monad

answerFix x n
  | producted > n = 0
  | otherwise = (n `div` producted) + answerFix (x + 1) n
  where
    !producted = foldl1 lcm [1..x]

answer n
  | odd n  =  (`mod` (7 + (10 ^ 9))) $ (fixed +) $ (n' + 1) * 2 + n' * 3
  | even n =  (`mod` (7 + (10 ^ 9))) $ (fixed +) $ n' * 2 + n' * 3
  where
      n' = n `div` 2
      fixed = answerFix 3 n

readInt :: String -> Int
readInt = read

main = do
  n <- readInt <$> getLine
  replicateM_ n $ do
    m <- readInt <$> getLine
    print $ answer m


You and your friend are participating in a TV show "Run For Your Prize".At the start of the show n prizes are located on a straight line. i-th prize is located at position ai. Positions of all prizes are distinct. You start at position 1, your friend — at position 106 (and there is no prize in any of these two positions). You have to work as a team and collect all prizes in minimum possible time, in any order.You know that it takes exactly 1 second to move from position x to position x + 1 or x - 1, both for you and your friend. You also have trained enough to instantly pick up any prize, if its position is equal to your current position (and the same is true for your friend). Carrying prizes does not affect your speed (or your friend's speed) at all.Now you may discuss your strategy with your friend and decide who will pick up each prize. Remember that every prize must be picked up, either by you or by your friend.What is the minimum number of seconds it will take to pick up all the prizes?

The first line contains one integer n (1 ≤ n ≤ 105) — the number of prizes. The second line contains n integers a1, a2, ..., an (2 ≤ ai ≤ 106 - 1) — the positions of the prizes. No two prizes are located at the same position. Positions are given in ascending order.

Print one integer — the minimum number of seconds it will take to collect all prizes.

NoteIn the first example you take all the prizes: take the first at 1, the second at 2 and the third at 8.In the second example you take the first prize in 1 second and your friend takes the other in 5 seconds, you do this simultaneously, so the total time is 5.

main = do
       ln1 <- getLine
       ln2 <- getLine
       let c = 10^6 :: Int
           s = map (\x -> read x :: Int) $ words ln2
       putStrLn $ show $ f s c

f l k
    | length c1 == 0 = k - minimum c2
    | length c2 == 0 = (maximum c1) - 1
    | True           = max ((maximum c1) - 1) (k - minimum c2)
    where c1 = [i | i <- l, i <= 500000]
          c2 = [i | i <- l, i > 500000]

import Control.Applicative

getRes :: Int -> Int
getRes x
    | x > 500000 = 1000000 - x
    | otherwise = x - 1

solve :: [Int] -> Int
solve (x:[]) = getRes x
solve (x:xs) = max (getRes x) (solve xs)

main :: IO ()
main = do
    getLine
    prizes <- map (read :: String -> Int) . words <$> getLine
    putStrLn . show $ solve prizes

import Data.List

main = getContents >>= print . solve . sort . (1:) . (1000000:) . map read . tail . words

solve as = minimum $ zipWith (\a0 a1 -> max (a0 - 1) (1000000 - a1)) as (tail as)

import Data.List

main = getContents >>= print . solve . sort . (1:) . (1000000:) . map read . words

solve as = minimum $ zipWith (\a0 a1 -> max (a0 - 1) (1000000 - a1)) as (tail as)

mdist = 1000000
middle = mdist `div` 2

main = do
    xs <- getLine >> getLine >>= return . (1:) . (mdist:) . map read . words
    let l = maximum [ x | x <- xs, x <= middle ] - 1
        r = 1000000 - minimum [ x | x <- xs, x > middle ]
    print $ max l r

main = do
       ln1 <- getLine
       ln2 <- getLine
       let c = 10^6 :: Int
           s = map (\x -> read x :: Int) $ words ln2
       putStrLn $ show $ f s c

f l k
    | length c1 == 0 = k - minimum c2
    | length c2 == 0 = (maximum c1) - 1
    | True           = max ((maximum c1) - 1) (k - minimum c2)
    where c1 = [i | i <- l, i <= quot k 2]
          c2 = [i | i <- l, i >= quot k 2]

import Data.List

main = getContents >>= print . solve . sort . (1:) . (1000000:) . map read . words

solve as = 1000000 - d - maximum ds
  where ds = zipWith (-) (tail as) as
        d = if maximum ds == head ds || maximum ds == last ds then 1 else 2


A $$$\mathbf{0}$$$-indexed array $$$a$$$ of size $$$n$$$ is called good if for all valid indices $$$i$$$ ($$$0 \le i \le n-1$$$), $$$a_i + i$$$ is a perfect square$$$^\dagger$$$.Given an integer $$$n$$$. Find a permutation$$$^\ddagger$$$ $$$p$$$ of $$$[0,1,2,\ldots,n-1]$$$ that is good or determine that no such permutation exists.$$$^\dagger$$$ An integer $$$x$$$ is said to be a perfect square if there exists an integer $$$y$$$ such that $$$x = y^2$$$.$$$^\ddagger$$$ An array $$$b$$$ is a permutation of an array $$$a$$$ if $$$b$$$ consists of the elements of $$$a$$$ in arbitrary order. For example, $$$[4,2,3,4]$$$ is a permutation of $$$[3,2,4,4]$$$ while $$$[1,2,2]$$$ is not a permutation of $$$[1,2,3]$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The only line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the permutation $$$p$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, output $$$n$$$ distinct integers $$$p_0, p_1, \dots, p_{n-1}$$$ ($$$0 \le p_i \le n-1$$$) — the permutation $$$p$$$ — if the answer exists, and $$$-1$$$ otherwise.

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

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x
--
-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

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

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

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

{- END OF GENERAL -}

solve' :: Int -> [[Int]]
solve' 0 = []
solve' 1 = [[0]]
solve' n = solve' p ++ [suffix]
    where
        n_ = n - 1
        k = ceiling . sqrt . fromIntegral $ n_
        p = (k * k - n_) -- `debugging` "p"
        suffix = reverse [p .. n_] -- `debugging` "suffix"

solve :: Int -> [Int]
solve = join . solve'

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


A piece of paper contains an array of n integers a1, a2, ..., an. Your task is to find a number that occurs the maximum number of times in this array.However, before looking for such number, you are allowed to perform not more than k following operations — choose an arbitrary element from the array and add 1 to it. In other words, you are allowed to increase some array element by 1 no more than k times (you are allowed to increase the same element of the array multiple times).Your task is to find the maximum number of occurrences of some number in the array after performing no more than k allowed operations. If there are several such numbers, your task is to find the minimum one.

The first line contains two integers n and k (1 ≤ n ≤ 105; 0 ≤ k ≤ 109) — the number of elements in the array and the number of operations you are allowed to perform, correspondingly. The third line contains a sequence of n integers a1, a2, ..., an (|ai| ≤ 109) — the initial array. The numbers in the lines are separated by single spaces.

In a single line print two numbers — the maximum number of occurrences of some number in the array after at most k allowed operations are performed, and the minimum number that reaches the given maximum. Separate the printed numbers by whitespaces.

NoteIn the first sample your task is to increase the second element of the array once and increase the fifth element of the array twice. Thus, we get sequence 6, 4, 4, 0, 4, where number 4 occurs 3 times.In the second sample you don't need to perform a single operation or increase each element by one. If we do nothing, we get array 5, 5, 5, if we increase each by one, we get 6, 6, 6. In both cases the maximum number of occurrences equals 3. So we should do nothing, as number 5 is less than number 6.In the third sample we should increase the second array element once and the fifth element once. Thus, we get sequence 3, 2, 2, 2, 2, where number 2 occurs 4 times.

module Main where

import Control.Applicative
import Data.List
import Control.Arrow

ptr2 _  _     []     _ _  acc = acc
ptr2 _ []     _      _ _  _ = error $ "Shit happend"
ptr2 k (x:xs) (y:ys) i sm acc
  | sm >  k = ptr2 k    xs (y:ys) (i-1) (sm - (y-x))                  acc
  | sm <= k = ptr2 k (x:xs)   ys  (i+1) (sm + (head ys-y)*i) ((i,y) : acc)

type I = Integer

solve :: I -> I -> [I] -> (I,I)
solve n k as = findBest cands
  where
    cands    = ptr2 k as' as' 1 0 []
    findBest = negSnd . maximum . map negSnd
    negSnd   = id *** negate
    as'      = sort as

main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine
  as    <- map read . words <$> getLine
  let (n',v) = solve n k as
  putStrLn $ show n' ++ " " ++ show v

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Control.Applicative

readInt64 bs = case B.readInt bs of Just (n,_) -> fromIntegral n

main = do
  [n,k] <- map read.words <$> getLine
  sorted <- sort.map readInt64.B.words <$> B.getLine
  putStrLn.unwords.map show $ solve k 0 0 qEmpty sorted

solve _ !len val _ [] = [len,val]
solve k !len val !q@(Q l s _ _ ) (x:xs)
  | l*x - s > k = solve k len val (deq q) (x:xs)
  | l+1 > len = solve k (l+1) x (enq x q) xs
  | otherwise = solve k len val (enq x q) xs

data Q = Q {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64 [Int64] [Int64]

qEmpty = Q 0 0 [] []

enq x (Q l s fs rs) = Q (l+1) (s+x) fs (x:rs)

deq (Q l s (f:fs) rs) = Q (l-1) (s-f) fs rs
deq (Q l s [] rs) = deq (Q l s (reverse rs) [])

{-# LANGUAGE BangPatterns #-}

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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [n,k] <- map read.words <$> getLine
  sorted <- sort.map readInteger.B.words <$> B.getLine
  putStrLn.unwords.map show $ solve k 0 0 qEmpty sorted

solve _ len val _ [] = [len,val]
solve k len val q@(Q l s _ _ ) (x:xs)
  | l*x - s > k = solve k len val (deq q) (x:xs)
  | l+1 > len = solve k (l+1) x (enq x q) xs
  | otherwise = solve k len val (enq x q) xs

data Q = Q {-# UNPACK #-} !Integer {-# UNPACK #-} !Integer [Integer] [Integer]

qEmpty = Q 0 0 [] []

enq x (Q l s fs rs) = Q (l+1) (s+x) fs (x:rs)

deq (Q l s (f:fs) rs) = Q (l-1) (s-f) fs rs
deq (Q l s [] rs) = deq (Q l s (reverse rs) [])


Polycarp has an integer $$$n$$$ that doesn't contain the digit 0. He can do the following operation with his number several (possibly zero) times: Reverse the prefix of length $$$l$$$ (in other words, $$$l$$$ leftmost digits) of $$$n$$$. So, the leftmost digit is swapped with the $$$l$$$-th digit from the left, the second digit from the left swapped with ($$$l-1$$$)-th left, etc. For example, if $$$n=123456789$$$ and $$$l=5$$$, then the new value of $$$n$$$ will be $$$543216789$$$.Note that for different operations, the values of $$$l$$$ can be different. The number $$$l$$$ can be equal to the length of the number $$$n$$$ — in this case, the whole number $$$n$$$ is reversed.Polycarp loves even numbers. Therefore, he wants to make his number even. At the same time, Polycarp is very impatient. He wants to do as few operations as possible.Help Polycarp. Determine the minimum number of operations he needs to perform with the number $$$n$$$ to make it even or determine that this is impossible.You need to answer $$$t$$$ independent test cases.

The first line contains the number $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each of the following $$$t$$$ lines contains one integer $$$n$$$ ($$$1 \le n < 10^9$$$). It is guaranteed that the given number doesn't contain the digit 0.

Print $$$t$$$ lines. On each line print one integer — the answer to the corresponding test case. If it is impossible to make an even number, print -1.

NoteIn the first test case, $$$n=3876$$$, which is already an even number. Polycarp doesn't need to do anything, so the answer is $$$0$$$.In the second test case, $$$n=387$$$. Polycarp needs to do $$$2$$$ operations: Select $$$l=2$$$ and reverse the prefix $$$\underline{38}7$$$. The number $$$n$$$ becomes $$$837$$$. This number is odd. Select $$$l=3$$$ and reverse the prefix $$$\underline{837}$$$. The number $$$n$$$ becomes $$$738$$$. This number is even.It can be shown that $$$2$$$ is the minimum possible number of operations that Polycarp needs to do with his number to make it even.In the third test case, $$$n=4489$$$. Polycarp can reverse the whole number (choose a prefix of length $$$l=4$$$). It will become $$$9844$$$ and this is an even number.In the fourth test case, $$$n=3$$$. No matter how hard Polycarp tried, he would not be able to make an even number.

{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.Array

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let digits = (read . pure) <$> str
        lEven = even (last digits)
        hEven = even (head digits)
        aEven = any even digits
    print $
      if | lEven -> 0
         | hEven -> 1
         | aEven -> 2
         | otherwise -> -1

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let digits = (read . pure) <$> str
        lEven = even (last digits)
        hEven = even (head digits)
        aEven = any even digits
    print $
      if | lEven -> 0
         | hEven -> 1
         | aEven -> 2
         | otherwise -> -1

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as String
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder
import Control.Monad
import Control.Monad.ST
--import Control.Monad.Trans.State
import Data.Array.Base
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.MArray as Vector
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import Data.Function
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe
import System.Exit

import Data.IORef
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Fail
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

import Control.Monad.Identity (Identity(..))

printLog :: Show a => a -> a
printLog a = unsafePerformIO $ do putStrLn $ "{отладка[ "++show a ++ " ]отладка}"
                                  pure a

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

readInts :: IO [Int]
readInts = map (fst . fromJust . String.readInt) . String.words <$> String.getLine

fita :: IO ()
fita = do
  n <- getLine
  let evens = foldr (\el suf -> suf || even (digitToInt el)) False n
  case evens of
    True -> print $ if (even . digitToInt . head . reverse $ n)
                        then 0
                    else if (even . digitToInt . head $ n)
                            then 1
                         else 2
    False -> print (-1)

main :: IO ()
main = flip replicateM_ fita =<< readLn

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

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

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

data TC = TC { n :: Int }

input :: Scanner TC
input = do
  n <- int
  return TC {..}

type Output = Int

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

solve :: TC -> Output
solve TC {..}
  | even n = 0
  | even (head ns) = 1
  | any even ns = 2
  | otherwise = -1
  where
    ns = [read [c] | c <- show n]

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


You are given sequence a1, a2, ..., an of integer numbers of length n. Your task is to find such subsequence that its sum is odd and maximum among all such subsequences. It's guaranteed that given sequence contains subsequence with odd sum.Subsequence is a sequence that can be derived from another sequence by deleting some elements without changing the order of the remaining elements.You should write a program which finds sum of the best subsequence.

The first line contains integer number n (1 ≤ n ≤ 105). The second line contains n integer numbers a1, a2, ..., an ( - 104 ≤ ai ≤ 104). The sequence contains at least one subsequence with odd sum.

NoteIn the first example sum of the second and the fourth elements is 3.

-- Codeforces 797B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

main :: IO ()
main = do
    getLine
    xs <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let (s, k) = foldl' (\(s, k) x -> if x >= 0
                                         then if x `mod` 2 == 1
                                                 then (s + x, min k x)
                                                 else (s + x, k)
                                         else if x `mod` 2 == 1
                                                 then (s, min k (- x))
                                                 else (s, k)) (0, maxBound :: Int) xs
    if s `mod` 2 == 0
       then print (s - k)
       else print s

main = getContents >>= print . solve . map (read :: String -> Int) . tail . words

solve :: [Int] -> Int
solve ls = if odd s then s else s - (minimum $ filter odd $ map abs ls)
  where s = sum $ filter (0 <) ls

import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List

solve v =
  let (e,o) = partition even v
      se = (sum.(filter (>0))) e
      (p,n) = partition (>0) o
      lp = length p
      so =
        if lp == 0
          then maximum n
          else
            if even lp
              then
                let sp = sum p
                    mp = minimum p in
                    if null n
                      then sp - mp
                      else max (sp - mp) (sp + (maximum n))
              else sum $ p
      in se + so

main = do
  n <- readLn::IO Int
  v <- ( (map (\x -> read x::Int)) . words ) <$> getLine
  print $ solve v

import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List

solve v =
  let (e,o) = partition even v
      se = (sum.(filter (>0))) e
      (p,n) = partition (>0) o
      lp = length p
      so =
        if lp == 0
          then maximum n
          else
            if even lp
              then sum $ tail $ sort p
              else sum $ p
      in se + so

main = do
  n <- readLn::IO Int
  v <- ( (map (\x -> read x::Int)) . words ) <$> getLine
  print $ solve v


A group of $$$n$$$ friends decide to go to a restaurant. Each of the friends plans to order meals for $$$x_i$$$ burles and has a total of $$$y_i$$$ burles ($$$1 \le i \le n$$$). The friends decide to split their visit to the restaurant into several days. Each day, some group of at least two friends goes to the restaurant. Each of the friends visits the restaurant no more than once (that is, these groups do not intersect). These groups must satisfy the condition that the total budget of each group must be not less than the amount of burles that the friends in the group are going to spend at the restaurant. In other words, the sum of all $$$x_i$$$ values in the group must not exceed the sum of $$$y_i$$$ values in the group.What is the maximum number of days friends can visit the restaurant?For example, let there be $$$n = 6$$$ friends for whom $$$x$$$ = [$$$8, 3, 9, 2, 4, 5$$$] and $$$y$$$ = [$$$5, 3, 1, 4, 5, 10$$$]. Then:   first and sixth friends can go to the restaurant on the first day. They will spend $$$8+5=13$$$ burles at the restaurant, and their total budget is $$$5+10=15$$$ burles. Since $$$15 \ge 13$$$, they can actually form a group.  friends with indices $$$2, 4, 5$$$ can form a second group. They will spend $$$3+2+4=9$$$ burles at the restaurant, and their total budget will be $$$3+4+5=12$$$ burles ($$$12 \ge 9$$$). It can be shown that they will not be able to form more groups so that each group has at least two friends and each group can pay the bill.So, the maximum number of groups the friends can split into is $$$2$$$. Friends will visit the restaurant for a maximum of two days. Note that the $$$3$$$-rd friend will not visit the restaurant at all.Output the maximum number of days the friends can visit the restaurant for given $$$n$$$, $$$x$$$ and $$$y$$$.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. The descriptions of the test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of friends. The second line of each test case contains exactly $$$n$$$ integers $$$x_1, x_2, \dots, x_n$$$ ($$$1 \le x_i \le 10^9$$$). The value of $$$x_i$$$ corresponds to the number of burles that the friend numbered $$$i$$$ plans to spend at the restaurant. The third line of each test case contains exactly $$$n$$$ integers $$$y_1, y_2, \dots, y_n$$$ ($$$1 \le y_i \le 10^9$$$). The value $$$y_i$$$ corresponds to the number of burles that the friend numbered $$$i$$$ has. It is guaranteed that the sum of $$$n$$$ values over all test cases does not exceed $$$10^5$$$.

For each test case, print the maximum number of days to visit the restaurant. If friends cannot form even one group to visit the restaurant, print 0.

NoteThe first test case in explained in the problem statement.In the second test case, friends cannot form at least one group of two or more people.In the third test case, one way to visit the restaurant in one day is to go in a group of all three friends ($$$1+3+10 \ge 2+3+7$$$). Note that they do not have the option of splitting into two groups.

{-# 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 qualified Data.Text as T

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe

import qualified Control.Monad as M
import qualified Control.Monad.State as M
import qualified Control.Monad.Trans.Maybe as M

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

import Data.Char

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

{- solution -}

iterateMaybe :: (a -> Maybe a) -> a -> [a]
iterateMaybe f x = case f x of
    Just y -> y : iterateMaybe f y
    Nothing -> []

solve :: Int -> [Int] -> [Int] -> Int
solve n xs ys = answer
    where
        ds = tracing "ds" $ zipWith (-) ys xs
        answer = length . iterateMaybe execRound . S.fromList $ zip ds [1..]

        execRound :: S.Set (Int, Int) -> Maybe (S.Set (Int, Int))
        execRound ds = flip M.evalState ds . M.runMaybeT $ do
            ((maxD, _), ds) <- M.MaybeT $ M.gets S.maxView
            M.put ds

            tracingM "maxD" maxD

            M.guard $ maxD >= 0

            (minD, t) <- M.MaybeT . M.gets $ S.lookupGE (- maxD, 0)
            M.modify $ S.delete (minD, t)

            tracingM "minD" minD

            M.get

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


The title is a reference to the very first Educational Round from our writers team, Educational Round 18.There is a bag, containing colored balls. There are $$$n$$$ different colors of balls, numbered from $$$1$$$ to $$$n$$$. There are $$$\mathit{cnt}_i$$$ balls of color $$$i$$$ in the bag. The total amount of balls in the bag is odd (e. g. $$$\mathit{cnt}_1 + \mathit{cnt}_2 + \dots + \mathit{cnt}_n$$$ is odd).In one move, you can choose two balls with different colors and take them out of the bag.At some point, all the remaining balls in the bag will have the same color. That's when you can't make moves anymore.Find any possible color of the remaining balls.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. The first line of each testcase contains a single integer $$$n$$$ ($$$1 \le n \le 20$$$) — the number of colors. The second line contains $$$n$$$ integers $$$\mathit{cnt}_1, \mathit{cnt}_2, \dots, \mathit{cnt}_n$$$ ($$$1 \le \mathit{cnt}_i \le 100$$$) — the amount of balls of each color in the bag. The total amount of balls in the bag is odd (e. g. $$$\mathit{cnt}_1 + \mathit{cnt}_2 + \dots + \mathit{cnt}_n$$$ is odd).

For each testcase, print a single integer — any possible color of the remaining balls, after you made some moves and can't make moves anymore.

NoteIn the first testcase, your first and only move can be one of the following:   take balls with colors $$$1$$$ and $$$2$$$;  take balls with colors $$$1$$$ and $$$3$$$;  take balls with colors $$$2$$$ and $$$3$$$. After the move, exactly one ball will remain. Its color can be $$$3, 2$$$ or $$$1$$$ depending on the move.In the second testcase, you can't make moves at all — there is only color of balls already. This color is $$$1$$$.In the third testcase, you can keep removing one ball of color $$$1$$$ and one ball of color $$$2$$$ until there are no more balls of color $$$1$$$. At the end, three balls of color $$$2$$$ remain.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = [Int]
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- readChar8
  -- print (n, xs)
  return xs

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [1..length xs] xs

-- try for the automatically generated if not fixed
solve :: Solver
solve d = case foldr go Nothing xs of
    Nothing -> print "error"
    Just (i, _) -> print i
  where xs = enumerate d
        go :: (Int, Int) -> Maybe  (Int, Int) -> Maybe (Int, Int)
        go x Nothing = Just x
        go (j, y) (Just (i, x))
          | x == y = Nothing
          | x > y = Just (i, x - y)
          | otherwise = Just (j, y - x)

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = [Int]
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- readChar8
  -- print (n, xs)
  return xs

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [1..length xs] xs

-- try for the automatically generated if not fixed
solve :: Solver
solve d = print $ go (head xs) (tail xs)
  where xs = enumerate d
        go :: (Int, Int) -> [(Int, Int)] -> Int
        go (i, _) [] = i
        go (i, x) ((j,y):ys)
          | x == y = go (head ys) (tail ys)
          | x > y = go (i, x-y) ys
          | otherwise = go (j, y-x) ys

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- ballcol.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import           Prelude               hiding (getLine)
import           Control.Arrow
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.List

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n] <- ri
        ri
    mapM_ (putStrLn.show.solve) tcs

solve = fst . maximumBy (compare`on`snd) . (cols`zip`)

cols = [1..] :: [Int]

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>
        map read . words <$> getLine >>=
        print . findMaxIdx

findMaxIdx :: [Int] -> Int
findMaxIdx (x:xs) = f xs 2 x 1
  where f [] _ _ i = i
        f (x:xs) xi m mi | x > m = f xs (xi+1) x xi
                         | otherwise = f xs (xi+1) m mi

maxIndex :: (Enum b,Ord a) => [a] -> b
maxIndex x = fst (maxIndex_ (toEnum 0) x) where
    maxIndex_ _ [] = error "empty list"
    maxIndex_ i [x] = (i,x)
    maxIndex_ i (x:xs) = if x >= snd y then (i,x) else y where
        y = maxIndex_ (succ i) xs

test_case_func :: (Num a,Eq a) => a -> IO ()
test_case_func 0 = return ()
test_case_func t = do
    n <- getLine
    cnts <- getLine
    print $ (maxIndex (map read $ words cnts :: [Int])) + 1
    test_case_func (t - 1)

main :: IO ()
main = do
    ts <- getLine
    test_case_func $ read ts

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}
{-# options_ghc -Wno-all-missed-specialisations  #-}
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import           Prelude               hiding (getLine)
import           Control.Arrow
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.List

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n] <- ri
        ri
    mapM_ (putStrLn.show.solve) tcs

solve = fst . maximumBy (compare`on`snd) . (cols`zip`)

cols = [1..] :: [Int]

import Control.Monad
import Data.List

solveCase :: [Int] -> Int
solveCase n = snd (head (reverse (sort (zip n [1..end]))))
    where end = length n

caseSolutionString :: [Int] -> String
caseSolutionString n = show sol
    where sol = solveCase n

readCase :: Int -> IO ([Int])
readCase i = do
    input <- getLine
    let n = (read input) :: Int
    input <- getLine
    let list = (map read (words input)) :: [Int]
    return list

main = do
    t <- getLine
    let tn = (read t) :: Int
    cases <- forM [1..tn] readCase
    mapM putStrLn (map caseSolutionString cases)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = [Int]
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- readChar8
  -- print (n, xs)
  return xs

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [0..length xs-1] xs

-- try for the automatically generated if not fixed
solve :: Solver
solve d = print $ go (head xs) (tail xs)
  where xs = enumerate d
        go :: (Int, Int) -> [(Int, Int)] -> Int
        go (i, _) [] = i
        go (i, x) ((j,y):ys)
          | x == y = go (head ys) (tail ys)
          | x > y = go (i, x-y) ys
          | otherwise = go (j, y-x) ys

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- ballcol.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import           Prelude               hiding (getLine)
import           Control.Arrow
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.List

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n] <- ri
        ri
    mapM_ (putStrLn.show.maximum) tcs