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

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

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


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

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

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

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


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


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 <= 500000]
          c2 = [i | i <- l, i > 500000]

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


{-# 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) [])

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


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

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

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


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

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

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


{-# LANGUAGE BangPatterns #-}

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

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  _ <- getLine
  minq <- minimum.map readInt.B.words <$> B.getLine
  _ <- getLine
  as <- sortBy(flip compare).map readInt.B.words <$> B.getLine
  print $ solve minq as

solve minq xs = go 0 xs
   where
     go !ans [] = ans
     go !ans xs = go (ans+sum ys) $ drop 2 zs
      where
        (ys,zs) = splitAt minq xs

import Data.List

minPrice mq prices =
  let (buy, left) = splitAt mq prices
  in case left of
        a:b:rest  -> sum buy + minPrice mq rest
        _         -> sum buy

main :: IO ()
main = do
  _ <- getLine
  qs <- fmap (map read . words) getLine
  _ <- getLine
  as <- fmap (map read . words) getLine
  let mq = minimum qs
      prices = reverse $ sort as
  print $ minPrice mq prices

import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Maybe

solve qs as = sum $ go $ nonIncSort as
  where go [] = []
        go xs = sum (take q xs):go (drop (q + 2) xs)
        q = minimum qs
        nonIncSort = sortBy (\x y -> compare y x)

parseInt = fst . fromJust . BS.readInt

main = do _ <- BS.getLine
          qs <- fmap (map parseInt . BS.words) BS.getLine
          _ <- BS.getLine
          as <- fmap (map parseInt . BS.words) BS.getLine
          putStrLn $ show $ solve qs as


import qualified Data.IntSet as S
import Data.Array.Unboxed
import Data.List

main = interact (show . answer . map (map read . words) . tail . lines)

answer :: [[Int]] -> Int
answer s = min (ans s) (ans (transpose s))
  where
    ans = minimum . map (sum . map (\x -> nextPrime x - x))

nextPrime :: Int -> Int
nextPrime = (arr !)
  where
    mx = 110000
    primes = go 2 (S.fromDistinctAscList [2..mx])
      where
        go x s | x*x > mx = S.toAscList s
               | x `S.notMember` s = go (x+1) s
               | otherwise =
          go (x+1) (s `S.difference` (S.fromDistinctAscList [x*x, x*x+x..mx]))
    ps = go 1 primes
      where
        go x   []               = []
        go x (d:dp) | x == d    = x : go (x+1) dp
                    | otherwise = d : go (x+1) (d:dp)
    arr :: UArray Int Int
    arr = listArray (1, mx) ps

import Control.Monad (liftM, replicateM)
import Data.Array
import Data.Char (ord)
import Data.List (intercalate)

isPrime :: Int -> Bool
isPrime n  =  all (\x -> mod n x /= 0)
  $ takeWhile (\x -> x * x <= n) primes

primes :: [Int]
primes  =  2 : filter isPrime [3,5..]

arrayDiffToPrime :: Array Int Int
arrayDiffToPrime  =  listArray (1,nextPrime 100000) $ listDiffToPrime 1 primes
  where
    listDiffToPrime i (p:ps)
      | i > p  =  listDiffToPrime i ps
      | otherwise  =  (p - i) : listDiffToPrime (i+1) (p:ps)
    nextPrime n  =  head $ dropWhile (< n) primes

solve :: Array (Int, Int) Int -> Int
solve array  =  min
    (minimum [sum [d ! (a ! (i, j)) | j <- [1..m]] | i <- [1..n]])
    (minimum [sum [d ! (a ! (i, j)) | i <- [1..n]] | j <- [1..m]])
  where
    (n, m)  =  snd $ bounds array
    d  =  arrayDiffToPrime
    a  =  array

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ass  <-  replicateM n reads
    let array  =  Data.Array.array ((1,1), (n,m))
         $ map (\(i, x) -> ((i `div` m + 1, i `mod` m + 1), x))
         $ zip [0..] $ concat ass
    print $ solve array
  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

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

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.Bits

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

main = do
  _ <- getLine
  xss <- map(map readInt.B.words).B.lines <$> B.getContents :: IO [[Int]]
  let yss = transpose xss
  print $ min (solve xss) (solve yss)

solve :: [[Int]] -> Int
solve xss = foldl1' min $ map (sum.map f) xss

f :: Int -> Int
f 1 = 1
f 2 = 0
f x
  | even x = 1 + f(x+1)
  | unsafeAt isPrime (x`unsafeShiftR`1) = 0
  | otherwise = 1 + f (x+1)

primeLimit = 100001
primeLimit2 = primeLimit`quot`2

isPrime :: UArray Int Bool
isPrime = runSTUArray $ do
  isp <- newArray (0,primeLimit`quot`2) True
  forM_ [1..isqrt primeLimit2] $ \i-> do
    flg <- unsafeRead isp i
    when flg $ do
      let !p = 2*i+1
          go !i = when (i<=primeLimit2) $ do
            unsafeWrite isp i False
            go $ i+p
      go $ i*(p+1)
  return isp

isqrt :: Int -> Int
isqrt x = floor.sqrt $ fromIntegral x


import qualified Data.Set as Set
import Data.List
import Control.Monad
import Data.Char

readInts = fmap (map read.words) getLine :: IO [Integer]
solve1 [] ys = True
solve1 (x:xs) (y:ys)
    | (x /= y) = False
    | otherwise = solve1 xs ys

solve2 [x] = True
solve2 [x,y] = True
solve2 (x:y:xs)
    | (x < y && z < y) = False
    | otherwise = solve2 (y:xs)
    where z = head xs

printS = do
    s<-getLine
    let a = sort s
        t = sort $ "qwertyuiopasdfghjklzxcvbnm"
    putStrLn $ if ((solve1 a t) && (solve2 s)) then "YES" else "NO"

main = do
    t<-readLn
    replicateM_ t printS

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.Char (chr, ord)

main :: IO ()
main = interact $ lines >>> drop 1 >>> map (isAlphabetic >>> bool "No" "Yes") >>> unlines

isAlphabetic :: String -> Bool
isAlphabetic "" = True
isAlphabetic s
  | head s == c = isAlphabetic $ tail s
  | last s == c = isAlphabetic $ init s
  | otherwise = False
  where
    c = chr $ ord 'a' + length s - 1

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

stringToArray :: String -> Array Int Int
stringToArray xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx = if (array ! lIdx) == nextChar then "YES" else "NO"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = stringToArray xs
    (lBound, rBound) = bounds array
    firstChar = ord 'a' + length xs -1

main = interact $ unlines . map solve . tail . lines

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

stringToArray :: String -> Array Int Int
stringToArray xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx =
    if ((array ! lIdx) == ordA) && (nextChar == ordA) then "YES" else "NO"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"
  where
    ordA = ord 'a'

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = stringToArray xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ unlines . map solve . tail . lines

import Control.Monad (replicateM_)
import Data.Char (ord, chr)
import Data.Sequence (Seq((:<|),(:|>), Empty))
import qualified Data.Sequence as S

isAlphabetical :: Seq Char -> Bool
isAlphabetical Empty = True
isAlphabetical (h :<| Empty ) = h == 'a'
isAlphabetical (h :<| (xs :|> l))
  | h == c = isAlphabetical (xs :|> l)
  | l == c = isAlphabetical (h :<| xs)
  | otherwise = False
  where
    c = chr $ ord 'a' + S.length xs + 1

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- S.fromList <$> getLine
    putStrLn $ if isAlphabetical s then "YES" else "NO"

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

{-# language NoMonomorphismRestriction #-}

{-# 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 -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List
import Data.Maybe
import Data.Bool

-- import Debug.Trace
-- tr s x = trace msg x  where msg = "tr: " ++ s ++ ": " ++ show x ++ "."

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t getLine

    (putStr . unlines . map solve) tcs

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

solve s = bool "NO" "YES" isAlph
  where
    (pref, suff) = span (/='a') s
    isAFound = (not.null) suff && head suff == 'a'
    isAlph = isAFound && check (succ 'a') [tail suff, reverse pref]

check c strings | null ss                 = True
                | filter (==c) hs /= [c]  = False
                | c == 'z'                = True
                | otherwise               = check (succ c) (zipWith joinHT hs ts)
  where
    ss = filter (not.null) strings
    (hs, ts) = unzip . map (fromJust.uncons) $ ss
    joinHT h t | (h == c)  = t
               | otherwise = h:t

module Main where

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    let n = length s
    putStrLn . yesOrNo $ f s n

f :: String -> Int -> Bool
f [x] _ = x == 'a'
f s@(x:xs) n
    | c == x       = f xs (n - 1)
    | c == last xs = f (init s) (n - 1)
    | otherwise    = False
    where c = chr (97 + n - 1)

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

good :: String -> Bool
good [] = True
good s
  | head s == ch = good $ tail s
  | last s == ch = good $ init s
  | otherwise = False
  where ch = ['a'..'z'] !! (length s - 1)

solve :: IO ()
solve = do
  s <- getLine
  putStrLn (if good s then "YES" else "NO")

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

import Data.Array (Array, bounds, listArray, (!))
import Data.Char
import Data.List (intercalate)

f :: String -> Array Int Int
f xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx && nextChar /= ord 'a' = "NO"
  | lIdx == rIdx && nextChar == ord 'a' = "YES"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = f xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ intercalate "\n" . map solve . tail . lines

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

f :: String -> Array Int Int
f xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx && nextChar /= ord 'a' = "NO"
  | lIdx == rIdx && nextChar == ord 'a' = "YES"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = f xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ unlines . map solve . tail . lines

import Control.Monad (replicateM_)
import Data.List (isPrefixOf)

isAlphabetical :: String -> Bool
isAlphabetical s = complete `isPrefixOf` ['a'..'z'] where
  left = reverse $ takeWhile (/= 'a') s
  right = dropWhile (/= 'a') s
  n = length left
  m = length right
  rest = if n > m then drop m left else drop n right
  org x y = [min x y, max x y]
  complete = concat (zipWith org left right) ++ rest

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- getLine
    putStrLn $ if isAlphabetical s then "YES" else "NO"


-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import           Data.Bool                (bool)
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

data Result = Yes | No deriving Show

solve :: [Int] -> Result
solve xs = bool No Yes $ head xs == 1

doCase :: IO ()
doCase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

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

import Control.Monad (replicateM_)

answer :: [Int] -> String
answer (1 : xs) = "YES"
answer _ = "NO"

solve = do
  l1 <- getLine
  let n = read l1 :: Int
  l2 <- getLine
  let arr = map (\x -> read x :: Int) (words l2)
  putStrLn (answer arr)

main = do
  input <- getLine
  let t = read input :: Int
  replicateM_ t solve

-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import           Data.Bool                (bool)
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

data Result = Yes | No deriving Show

solve :: [Int] -> Result
solve xs = bool No Yes $ first <= second
  where
  first = head xs
  second = xs !! 1

doCase :: IO ()
doCase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

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


import Control.Monad (replicateM_)
import Data.Char (intToDigit)
import qualified Data.Set as Set

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

isPossible :: [Int] -> Bool
isPossible [n, m, a, b] = n * a == m * b

buildRow :: Int -> (Int, Int) -> [Int]
buildRow m (lo, hi) = [if inRange idx then 0 else 1 | idx <- [0..m-1]] where
    zeroIndices = Set.fromList [idx `mod` m | idx <- [lo..hi]]
    inRange idx = Set.member idx zeroIndices

buildMatrix :: [Int] -> [[Int]]
buildMatrix [n, m, a, b] =
    snd $ foldr (\ idx (range, matrix) -> (newRange range, newMatrix idx range matrix)) ((0, m - a - 1), [[]]) [0..n-1] where
        newMatrix idx range matrix = buildRow m range : matrix
        newRange (lo, hi) = (hi + 1, hi + m - a)

printMatrix :: [[Int]] -> IO ()
printMatrix (xs: [[]]) = putStrLn (map intToDigit xs)
printMatrix (xs: xss) = putStrLn (map intToDigit xs) >> printMatrix xss

printAns :: [Int] -> IO ()
printAns sizes =
    if not $ isPossible sizes then putStrLn "NO"
    else putStrLn "YES" >> printMatrix (buildMatrix sizes)

main =
    read <$> getLine >>= \t ->
    replicateM_ t (readLine >>= printAns)

import           Data.List
import           Data.Array
import           Control.Monad
-- import           Debug.Trace

-- debug = flip trace

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c
        | length idxs /= b = Nothing
        | c == m = if all (== a) (elems rowcnts') then Just mat' else Nothing
        | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1 --`debug` show (elems rowcnts)
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List
main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [n, m, a, b] <- map read . words <$> getLine
        mapM putStrLn $ case solve n m b of
            (rowcnts, mats) | all (== a) rowcnts ->
                "YES" : map (concatMap show) (transpose mats)
            _ -> ["NO"]

solve :: Int -> Int -> Int -> ([Int], [[Int]])
solve n m b = mapAccumL go (replicate n 0) [1 .. m]  where
    go rowcnts c = (zipWith (+) row rowcnts, row)      where
        row =
            map fst
                $ sortOn snd
                $ zip (replicate b 1 ++ repeat 0)
                $ map fst
                $ sortOn snd
                $ zip [1 ..] rowcnts

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:a:b:_) <- map read . words <$> getLine
    if n * a == m * b
        then putStr $
             unlines $
             ("YES" :) $
             take n $ map (take m . (`drop` (cycle $ replicate a '1' ++ replicate (m - a) '0')) . (* a)) [0 ..]
        else putStrLn "NO"

import Control.Monad ( replicateM_ )
import Data.List     ( intercalate )

readInput = map read . words <$> getLine

abMatrix :: [Int] -> [String]
abMatrix [n, m, a, b]
    | n * a /= m * b = ["NO"]
    | otherwise =
        "YES" : take n (iterate (offset m a) firstRow)
    where
        firstRow = replicate a '1' ++ replicate (m-a) '0'
        offset n k list = suf ++ pre where (pre, suf) = splitAt (n-k) list

main = do
    t <- read <$> getLine
    replicateM_ t (abMatrix <$> readInput >>= putStr.unlines)

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/G

import Control.Monad ( replicateM_ )

abMatrix :: [Int] -> [String]
abMatrix [n, m, a, b]
    | n * a /= m * b = ["NO"]
    | otherwise =
        "YES" : take n (iterate (rotate a) firstRow)
    where
        firstRow = replicate a '1' ++ replicate (m-a) '0'
        rotate = drop <> take

readInput :: IO [Int]
readInput = map read . words <$> getLine

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (abMatrix <$> readInput >>= putStr.unlines)

import Data.Array (accumArray, Ix, Array, (!))

indicator :: (Ix a) => (a,a) -> [a] -> Array a Char
indicator bnds li = accumArray (\_ _ -> '1') '0' bnds (li `zip` repeat ())

soln :: Int -> Int -> Int -> Int -> String
soln n m a b
  | minimum [n, m, a, b] < 0  = "NO\n"
  | n * a /= m * b    = "NO\n"
  | a > m             = "NO\n"
  | n == 0 || m == 0  = "YES\n"
  | otherwise = "YES\n" ++ result  where
    baseLine = ((0,0) :) . takeWhile (/= (0,0)) . tail $ iterate stepD (0,0)
    stepD (x,y) = (rem (x+1) n, rem (y+1) m)
    k = quot (n*a) (length baseLine)
    bnds = ((0,0), (n-1,m-1))
    arr = indicator bnds [(rem (x+i) n, y)
                          | (x,y) <- baseLine, i <- [1..k]]
    result = unlines [[arr ! (i, j) | j <- [0..(m-1)]] | i <- [0..(n-1)]]

solveLine :: String -> String
solveLine line = case  map read $ words line  of
  [n, m, a, b] -> soln n m a b
  _ -> "bad format\n"

main :: IO ()
main = interact (concatMap solveLine . tail . lines)

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

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c | c > m = if all (== a) rowcnts' then Just mat else Nothing
                     | length idxs < b = Nothing
                     | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List
main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [n, m, a, b] <- map read . words <$> getLine
        mapM putStrLn $ case solve n m b of
            (rowcnts, mats) | all (== a) rowcnts ->
                "YES" : map (concatMap show) mats
            _ -> ["NO"]

solve :: Int -> Int -> Int -> ([Int], [[Int]])
solve n m b = mapAccumL go (replicate n 0) [1 .. m]  where
    go rowcnts c = (zipWith (+) row rowcnts, row)      where
        row =
            map fst
                $ sortOn snd
                $ zip (replicate b 1 ++ repeat 0)
                $ map fst
                $ sortOn snd
                $ zip [1 ..] rowcnts

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

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c | c > m = if all (== a) rowcnts' then Just mat else Nothing
                     | length idxs /= b = Nothing
                     | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Data.List
import           Data.Array
import           Control.Monad
-- import           Debug.Trace

-- debug = flip trace

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c
        | c == m = if all (== a) (elems rowcnts') then Just mat' else Nothing
        | length idxs /= b = Nothing
        | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1 --`debug` show (elems rowcnts)
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- map read . words <$> getLine
        let mat =
                [ [ if div i b == div j a then 1 else 0 | j <- [0 .. m - 1] ]
                | i <- [0 .. n - 1]
                ]
        mapM putStrLn
            $ if all ((== a) . sum) mat && all ((== b) . sum) (transpose mat)
                  then "YES" : map (concatMap show) mat
                  else ["NO"]

import Data.Array (accumArray, Ix, Array, (!))
import Data.List (intersperse)

indicator :: (Ix a) => (a,a) -> [a] -> Array a Char
indicator bnds li = accumArray (\_ _ -> '1') '0' bnds (li `zip` repeat ())

soln :: Int -> Int -> Int -> Int -> String
soln n m a b
  | minimum [n, m, a, b] < 0  = "NO\n"
  | n * a /= m * b    = "NO\n"
  | a > m             = "NO\n"
  | n == 0 || m == 0  = "YES\n"
  | otherwise = "YES\n" ++ unlines results  where
    baseLine = ((0,0) :) . takeWhile (/= (0,0)) . tail $ iterate stepD (0,0)
    stepD (x,y) = (rem (x+1) n, rem (y+1) m)
    k = quot (n*a) (length baseLine)
    bnds = ((0,0), (n-1,m-1))
    arr = indicator bnds [(rem (x+i) n, y)
                          | (x,y) <- baseLine, i <- [1..k]]
    results = [intersperse ' ' [arr ! (i, j) | j <- [0..(m-1)]]
                                             | i <- [0..(n-1)]]

solveLine :: String -> String
solveLine line = case  map read $ words line  of
  [n, m, a, b] -> soln n m a b
  _ -> "bad format\n"

main :: IO ()
main = interact (concatMap solveLine . tail . lines)