{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type Pos = (Int, Int)

add (x1, y1) (x2, y2) = (x1+x2, y1+y2)

process :: [Pos] -> [Pos] -> Pos
process obelisks clues = minimum obelisks `add` maximum clues

main = do
    n <- getInt
    obelisks <- force <$> replicateM n (readPoint <$> getInts)
    clues <- force <$> replicateM n (readPoint <$> getInts)
    putStrLn $ showPoint $ process obelisks clues

readPoint (x:y:[]) = (x, y)
showPoint (x, y) = show x ++ " " ++ show y

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- unfoldr (\bs0 -> do (x,bs1) <- BSL.readInt $ BSL.dropWhile (<'!') bs0
                            (y,bs2) <- BSL.readInt $ BSL.dropWhile (<'!') bs1
                            return ((x,y),bs2)) <$> BSL.getContents
  let (xys, ls1) = splitAt n ls
      abs = take n ls1
      (x,y) = minimum xys
      (a,b) = maximum abs
  putStrLn $ shows (a+x) $ ' ' : show (y+b)

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve obel clue = (x,y)
    where x = maximum (map fst obel) + minimum (map fst clue)
          y = maximum (map snd obel) + minimum (map snd clue)

tuple [x,y] = (x,y)

main = do
    [n] <- getInts
    obel <- forM [1..n] (\_-> getInts)
    clue <- forM [1..n] (\_-> getInts)
    let (x, y) = solve (map tuple obel) (map tuple clue)
    putStrLn $ show x ++ " " ++ show y


import Data.List

digits _    0 _   = []
digits base n num = num `mod` base : digits base (n - 1) (num `div` base)

main = do
    contents <- getContents
    let [n, k, d] = map read $ words contents
    let ans = transpose $ map (map (+ 1) . digits k d) [1..n]
    putStr (if (k ^ d) < n  then "-1" else unlines $ map (unwords . map show) ans)

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > (k^d) = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List (transpose)

main = interact $ f . map read . words

f :: [Integer] -> String
f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' (fromIntegral n) b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

-- Codeforces 459C

import Data.List

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

solve :: [Int] -> String
solve [n, k, d] = if check $ map toInteger [n, k, k, d]
    then "-1"
    else intercalate "\n" $ map (intercalate " " . map show) $ transpose $ scanl (\acc _ -> inc acc) (replicate d 1) [1..n-1] where inc = tail . map snd . scanl (\(cin, _) x -> if x+cin > k then (1, x+cin-k) else (0, x+cin)) (1, 0)

check :: [Integer] -> Bool
check [n, _, _, 0] = True
check [n, acc, k, d] = if acc >= n then False else check [n, (k*acc), k, (d-1)]

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List (transpose)

main = interact $ f . map read . words

f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' n b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k) : (kd k (d-1) (n`div`k))


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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x `mod` 2 /= 0 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = readInt >>= flip replicateM solve >>= mapM_ putStrLn

solve = do
	s <- getLine
	let
		candidates = map fst $ filter ( odd . snd ) $ map ( head &&& length ) $ group s
	return $ map head $ group $ sort candidates

import           Data.List

(|>) = flip (.)

main :: IO ()
main = interact $
  lines
  |> tail
  |> map solve
  |> unlines

solve :: String -> String
solve = group
  |> filter (length |> odd)
  |> map head
  |> nub
  |> sort

import Data.List

f =  sort . nub . map head . filter  (odd . length) .  group

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

import Data.List

f =  map head . filter  (odd . length) .  group

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

import Data.List

f =  nub . reverse . map head . filter  (odd . length) .  group

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

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else S.delete (head x) s) S.empty (group str)
    putStrLn $ S.toList res

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x /= 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res


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

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, k] <- map read . words <$> getLine :: IO [Int]
    let x = [0..n-1]
    let y = concat [map (\a -> (a + z) `mod` n) x | z <- x]
    let z = concat $ replicate n x
    let grid = generateG n $ take k $ zip y z
    let minF = score grid + score (transpose grid)
    print minF
    putStrLn $ unlines grid
  where
    score :: [String] -> Int
    score g = (maximum cnt - minimum cnt) ^ 2
      where
        cnt = map (length . filter (=='1')) g
    generateG :: Int -> [(Int, Int)] -> [String]
    generateG n l = [map (f . (,) y) x | y <- x]
      where
        x = [0..n-1]
        m = Set.fromList l
        f :: (Int, Int) -> Char
        f a | Set.member a m = '1'
            | otherwise = '0'

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  let a = solve n k
  print $ f a
  putStr $ unlines $ map (>>= show) a

f a = (maximum r - minimum r) ^ 2 + (maximum c - minimum c) ^ 2
  where
    r = map sum a
    c = map sum $ transpose a

solve n k = skew n $ makeRows n $ replicate k 1 ++ replicate (n * n - k) 0

makeRows n [] = []
makeRows n as = take n as : makeRows n (drop n as)

skew n = map (take n) . zipWith drop [0 ..] . map cycle . transpose


import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Maybe

solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		--  runSTUArray prevents copying
		compatibles = runSTUArray $ do
			-- attempt to STArray Int (Maybe Int) leads to huge memory usage
			a <- newArray (0, m) (-1) :: ST s (STUArray s Int Int)
			forM_ xs $ \x -> writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	putStrLn $ unwords $ map show $ solve xs

import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Maybe

-- TODO
-- http://codeforces.ru/contest/165/submission/2510862
-- watashi has shorter solution but my attempt to simplify like he does leads to TLE !?

solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		--  runSTUArray prevents copying
		-- attempt to STArray Int (Maybe Int) leads to huge memory usage
		compatibles = runSTUArray $ do
			a <- newArray (0, m) $ (-1 :: Int)
			forM_ xs $ \x -> writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	putStrLn $ unwords $ map show $ solve xs

import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Maybe

solve :: [Int] -> [Int]
solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		compatibles = runSTUArray $ do
			a <- newArray (0, m) (-1) :: ST s (STUArray s Int Int)
			forM_ xs $ \x -> do
				writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	-- xs <- (map read . words) `fmap` getLine
	putStrLn $ unwords $ map show $ solve xs

{-# OPTIONS_GHC -O2 -optc-O3 -fignore-asserts #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.Unboxed
import Data.Array.ST
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao a = map ((c!) . xor m) a
  where
    n = 22
    m = 2 ^ n - 1
    c = runSTUArray gao' where
      gao' = do
        x <- newArray (0, m) $ -1 :: ST s (STUArray s Int Int)
        forM_ a $ \i -> do
          writeArray x i i
        forM_ [0 .. m] $ \i -> do
          e <- liftM (head . (++[-1]) . filter (>0)) $ mapM (readArray x) $ i:
            [xor i j | j <- map (shiftL 1) [0 .. n - 1], i .&. j /= 0]
          writeArray x i e
        return x

main = do
  C.getLine
  a <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  putStrLn $ unwords $ map show $ gao a


--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : tuple2 l

test :: C.ByteString -> Int
test s = min (l - l1) (l - l2)
  where
    l = C.length s
    l1 = C.length $ C.dropWhile (== '<') s
    l2 = C.length $ C.dropWhile (== '>') $ C.reverse s

test' :: (C.ByteString, C.ByteString) -> Int
test' (n, s) = test $ C.take (ri n) s

solve (snt:a) = mconcat $ map (enc . test') $ tuple2 $ take (2 * nt) a
  where
    nt = ri snt
    enc n = intDec n <> char7 '\n'

main :: IO ()
main = hPutBuilder stdout . solve . C.words =<< C.getContents

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.ST.Lazy.Safe (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy.Safe as STL
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  t <- readInt <$> getLine
  replicateM_ t $ do
    n <- getLine
    s <- BS.takeWhile (>='!') <$> BS.getLine
    let l = BS.length $ BS.takeWhile (=='<') s
        r = BS.length $ snd $ BS.spanEnd (=='>') s
    print $ min l r

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : tuple2 l

test :: C.ByteString -> Int
test s
  | C.length s == 1 = 0
  | C.head s == '>' = 0
  | C.last s == '<' = 0
  | otherwise  = 1

test' :: (C.ByteString, C.ByteString) -> Int
test' (n, s) = test $ C.take (ri n) s

solve (snt:a) = mconcat $ map (enc . test') $ tuple2 $ take (2 * nt) a
  where
    nt = ri snt
    enc n = intDec n <> char7 '\n'

main :: IO ()
main = hPutBuilder stdout . solve . C.words =<< C.getContents


import Control.Applicative
import Text.Printf

f i m n = i * ( (i/m)^n - ( (i-1)/m)^n)

main = do
    l <- map read . words <$> getLine :: IO [Integer]
    m <- return $ head l
    n <- return $ last l
    printf "%.12f\n" $ sum $ [ f (fromIntegral i :: Double) (fromIntegral m :: Double) n | i <- [1..m]]

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

fastPower :: Num a => a -> Int -> a
fastPower x 0 = 1
fastPower x 1 = x
fastPower x n
    | n `mod` 2 == 1 = half * half * x
    | otherwise      = half * half
    where
    half = fastPower x (n `div` 2)

gao :: Int -> Int -> Double
gao m n = foldl' (+) 0.0 $ map (\x -> ((probabilities!x) - (probabilities!(x-1))) * (fromIntegral x)) [1 .. m]
    where
    probabilities = listArray (0, m) (map (\x -> fastPower ((fromIntegral x) / (fromIntegral m)) n) [0 .. m])

main = do
    (m:n:_) <- getInts
    putStrLn $ show $ gao m n
    where
    getInts :: IO [Int]
    getInts = (map read . words) <$> getLine

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

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

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

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

  let
    m' = fromIntegral m
    v = sum $ [i * ((i/m')^n - ((i-1)/m')^n) | i <- map fromIntegral [1..m]] :: Double

  print v

import Control.Arrow((>>>))
import Text.Printf

itof :: Int -> Double
itof = fromIntegral

p m n i = f i - f (i-1) where
  f i = (itof i / itof m) ^ n

e :: Int -> Int -> Double
e m n = sum [p m n i * itof i | i <- [1..m]]

main :: IO ()
main = do
  [m,n] <- getLine >>= (words >>> map read >>> return)
  printf "%.5f\n" $ e m n

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

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

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

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

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

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  [m, n] <- getInts

  let es :: Int -> Double -> Double -> Double
      es 1 p !acc = acc + p
      es i p !acc =
        let cur = p * (1 - ((cast i - 1) / cast i) ** cast n)
        in es (i-1) (p - cur) $ acc + cast i * cur

  print (es m 1 0 :: Double)

chanceALOnce m n = 1 - (1 - 1 / fromIntegral n) ^ m
solve m 1 = 1
solve m n =
  chanceALOnce m n * fromIntegral n + (1 - chanceALOnce m n) * solve m (n-1) :: Double
s[m,n]=solve n m
main=interact$show.s.map read.words


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

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

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

data Edge = Edge !Int !Int

dijkstra g source = runST $ do
    ds :: STUArray s Int Int64 <- newArray (1, n) maxBound
    writeArray ds source 0
    ps :: STUArray s Int Int <- newArray (1, n) 0

    let
      step :: Set (Int64, Int) -> ST s ()
      step q =
          case Set.minView q of
            Nothing -> return ()
            Just ((d, v), q) -> do
              let
                relax q (Edge u w) = do
                    d <- readArray ds u

                    if d' < d
                      then do
                        writeArray ds u d'
                        writeArray ps u v
                        return $ Set.insert (d', u) q
                      else return q
                  where
                    d' = d + (fromIntegral w)

              foldM relax q (g!v) >>= step

    step $ Set.singleton (0, source)

    ds' :: UArray Int Int64 <- freeze ds
    ps' :: UArray Int Int <- freeze ps
    return (ds', ps')
  where
    n = snd $ bounds g

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

  g ::Array Int [Edge] <- do
    a :: IOArray Int [Edge] <- newArray (1, n) []
    replicateM m $ do
      [u, v, w] <- getInts

      readArray a u >>= \es -> writeArray a u $ (Edge v w):es
      readArray a v >>= \es -> writeArray a v $ (Edge u w):es
    freeze a

  let
    (ds, ps) = dijkstra g 1

    path 0 = []
    path u = u:(path $ ps!u)

  if ds!n == maxBound
     then print $ -1
     else putStrLn $ unwords $ map show $ reverse $ path n

import qualified Data.List as List
import qualified Data.Sequence as Sequence

type Edge = (Int, Int)
type Graph = Sequence.Seq [Edge]
type Paths = Sequence.Seq Int
type DijkstraHeap = MinHeap (Int, Int, Int)

data MinHeap a = HeapEmpty | HeapNode Int a (MinHeap a) (MinHeap a)

rank :: MinHeap a -> Int
rank HeapEmpty = 0
rank (HeapNode x _ _ _) = x

singleton :: a -> MinHeap a
singleton x = HeapNode 1 x HeapEmpty HeapEmpty

merge :: (Ord a) => MinHeap a -> MinHeap a -> MinHeap a
merge HeapEmpty heap = heap
merge heap HeapEmpty = heap
merge lheap rheap = let
    HeapNode _ lval lc rc = lheap
    HeapNode _ rval _ _ = rheap
  in if rval < lval
    then merge rheap lheap
    else let rc' = merge rc rheap
      in if rank lc < rank rc'
        then HeapNode (rank lc + 1) lval rc' lc
        else HeapNode (rank rc' + 1) lval lc rc'

insert :: (Ord a) => a -> MinHeap a -> MinHeap a
insert = merge . singleton

pop :: (Ord a) => MinHeap a -> Maybe (a, MinHeap a)
pop HeapEmpty = Nothing
pop (HeapNode _ val lc rc) = Just (val, merge lc rc)

main :: IO()
main = do
  input <- lines <$> getContents
  let
    readInts = map (read :: String -> Int) . words
    [n, m] = readInts $ head input
    graph = buildGraph n . map readInts $ tail input
    resultString = concat . List.intersperse " " . map show $ dijkstra n graph
  putStrLn resultString

buildGraph :: Int -> [[Int]] -> Graph
buildGraph n edges = let
    initGraph = Sequence.replicate (n + 1) []
    addEdge :: [Int] -> Graph -> Graph
    addEdge [u, v, w] = Sequence.adjust ((w, v) :) u . Sequence.adjust ((w, u) :) v
  in foldr addEdge initGraph edges

dijkstra :: Int -> Graph -> [Int]
dijkstra n graph = let
    initHeap = singleton (0, 0, 1)
    initPaths = Sequence.replicate (n + 1) (-1)
    recurse :: DijkstraHeap -> Paths -> Paths
    recurse heap paths =
      case pop heap of
        Nothing -> paths
        Just ((dist, p, u), heap') ->
          if Sequence.index paths u == -1
          then let
              paths' = Sequence.update u p paths
              heap'' = foldr updateHeap heap' $ Sequence.index graph u
              updateHeap :: Edge -> DijkstraHeap -> DijkstraHeap
              updateHeap (w, v) = insert (dist + w, u, v)
            in recurse heap'' paths'
          else recurse heap' paths
    paths = recurse initHeap initPaths
    getPath :: Int -> [Int]
    getPath 0 = []
    getPath u = u : (getPath $ Sequence.index paths u)
    resultPath =
      case Sequence.index paths n of
        -1 -> [-1]
        _ -> getPath n
  in reverse resultPath

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import qualified Data.Map as M
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array
import Data.Int

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

infinity = 10 ^ 16

solve (n:m:rest) = dijkstra n graph 1 n
  where g = take (3*m) rest
        graph = buildG n g

buildG n g = runSTArray $ do
  graph <- newArray (1, n) []
  let rList [] = []
      rList (fr:to:w:rest) = (fr, to, w) : rList rest
  forM_ (rList g) $ \(fr, to, w) -> do
    cfr <- readArray graph fr
    writeArray graph fr ((to, w): cfr)
    cto <- readArray graph to
    writeArray graph to ((fr, w): cto)
  return graph

dijkstra n graph start finish = makePath finish []
  where startDists = foldl addv M.empty [1 .. n]
        addv m v | v == start = M.insert start (0 :: Int64, start) m
        addv m v = M.insert v (infinity, -1) m
        relax (v, dv, dists, queue) (to, w)
          | new < cur = (v, dv, distsUpd, queueUpd)
          | otherwise = (v, dv, dists, queue)
          where (cur, _) = dists M.! to
                new = dv + (fromIntegral w)
                queueUpd = S.insert (new, to) $ S.delete (cur, to) queue
                distsUpd = M.adjust (\_ -> (new, v)) to dists
        relaxAll dists queue | queue == S.empty = dists
        relaxAll dists queue = relaxAll distsUpd queueUpd
          where ((dv, v), queueNoV) = S.deleteFindMin queue
                (_, _, distsUpd, queueUpd) = foldl relax (v, dv, dists, queueNoV) (graph ! v)
        finalDists = relaxAll startDists (S.singleton (0, start))
        makePath v path
          | from < 0 = [-1]
          | v == start = v : path
          | otherwise = makePath from (v : path)
          where (_, from) = finalDists M.! v

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

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

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

dijkstra g source = runST $ do
    ds :: STUArray s Int Int64 <- newArray (1, n) maxBound
    writeArray ds source 0
    ps :: STUArray s Int Int <- newArray (1, n) 0

    let
      step :: Set (Int64, Int) -> ST s ()
      step q =
          case Set.minView q of
            Nothing -> return ()
            Just ((d, v), q) -> do
              let
                relax q (u, w) = do
                    d <- readArray ds u

                    if d' < d
                      then do
                        writeArray ds u d'
                        writeArray ps u v
                        return $ Set.insert (d', u) q
                      else return q
                  where
                    d' = d + (fromIntegral w)

              foldM relax q (g!v) >>= step

    step $ Set.singleton (0, source)

    ds' :: UArray Int Int64 <- freeze ds
    ps' :: UArray Int Int <- freeze ps
    return (ds', ps')
  where
    n = snd $ bounds g

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

  let
    g  :: Array Int [(Int, Int)]
    g = accumArray (flip (:)) [] (1, n) $ concat $ map (\[u, v, w] -> [(u, (v, w)), (v, (u, w))]) es

    (ds, ps) = dijkstra g 1

    path 0 = []
    path u = u:(path $ ps!u)

  if ds!n == maxBound
     then print $ -1
     else putStrLn $ unwords $ map show $ reverse $ path n

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import qualified Data.Map as M
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

infinity = 10 ^ 16

solve (n:m:rest) = dijkstra n graph 1 n
  where g = take (3*m) rest
        graph = buildG n g

buildG n g = runSTArray $ do
  graph <- newArray (1, n) []
  let rList [] = []
      rList (fr:to:w:rest) = (fr, to, w) : rList rest
  forM_ (rList g) $ \(fr, to, w) -> do
    cfr <- readArray graph fr
    writeArray graph fr ((to, w): cfr)
    cto <- readArray graph to
    writeArray graph to ((fr, w): cto)
  return graph

dijkstra n graph start finish = makePath finish []
  where startDists = foldl addv M.empty [1 .. n]
        addv m v | v == start = M.insert start (0, start) m
        addv m v = M.insert v (infinity, -1) m
        relax (v, dv, dists, queue) (to, w)
          | new < cur = (v, dv, distsUpd, queueUpd)
          | otherwise = (v, dv, dists, queue)
          where (cur, _) = dists M.! to
                new = dv + w
                queueUpd = S.insert (new, to) $ S.delete (cur, to) queue
                distsUpd = M.adjust (\_ -> (new, v)) to dists
        relaxAll dists queue | queue == S.empty = dists
        relaxAll dists queue = relaxAll distsUpd queueUpd
          where ((dv, v), queueNoV) = S.deleteFindMin queue
                (_, _, distsUpd, queueUpd) = foldl relax (v, dv, dists, queueNoV) (graph ! v)
        finalDists = relaxAll startDists (S.singleton (0, start))
        makePath v path
          | from < 0 = [-1]
          | v == start = v : path
          | otherwise = makePath from (v : path)
          where (_, from) = finalDists M.! v

import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import qualified Data.Map as M
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array

readInt s = let Just (a, _) = BS.readInt s in a

main = BS.interact $ BS.unwords . map (BS.pack . show) . solve . map readInt . BS.words

infinity = 10 ^ 16

solve (n:m:rest) = dijkstra n graph 1 n
  where g = take (3*m) rest
        graph = buildG n g

buildG n g = runSTArray $ do
  graph <- newArray (1, n) []
  let rList [] = []
      rList (fr:to:w:rest) = (fr, to, w) : rList rest
  forM_ (rList g) $ \(fr, to, w) -> do
    cfr <- readArray graph fr
    writeArray graph fr ((to, w): cfr)
    cto <- readArray graph to
    writeArray graph to ((fr, w): cto)
  return graph

dijkstra n graph start finish = makePath finish []
  where startDists = foldl addv (M.singleton start (0, start)) [1 .. n]
        addv m v | v == start = m
        addv m v = M.insert v (infinity, -1) m
        relax (v, dv, dists, queue) (to, w)
          | new < cur = (v, dv, distsUpd, queueUpd)
          | otherwise = (v, dv, dists, queue)
          where (cur, _) = dists M.! to
                new = dv + w
                queueUpd = S.insert (new, to) $ S.delete (cur, to) queue
                distsUpd = M.adjust (\_ -> (new, v)) to dists
        relaxAll dists queue | queue == S.empty = dists
        relaxAll dists queue = relaxAll distsUpd queueUpd
          where ((dv, v), queueNoV) = S.deleteFindMin queue
                (_, _, distsUpd, queueUpd) = foldl relax (v, dv, dists, queueNoV) (graph ! v)
        finalDists = relaxAll startDists (S.singleton (0, start))
        makePath v path
          | from < 0 = [-1]
          | from == v = v : path
          | otherwise = makePath from (v : path)
          where (_, from) = finalDists M.! v


type Result = (Int, Maybe String)

solve :: [String] -> String
solve lines = getResult (solve_ ((0, Nothing), (0, Nothing)) lines)
  where
    solve_ :: (Result, Result) -> [String] -> (Result, Result)
    solve_ results [] = results
    solve_ ((_, Nothing), (_, Nothing)) (a:as) = solve_ ((1, Just a), (0, Nothing)) as
    solve_ ((res1, Just name1), (_, Nothing)) (a:as)
        | name1 == a = solve_ ((res1 + 1, Just name1), (0, Nothing)) as
        | otherwise = solve_ ((res1, Just name1), (1, Just a)) as
    solve_ ((res1, Just name1), (res2, Just name2)) (a:as)
        | (name1 == a) = solve_ ((res1 + 1, Just name1), (res2, Just name2)) as
        | (name2 == a) = solve_ ((res1, Just name1), (res2 + 1, Just name2)) as
        | otherwise = error "Komand bol'we 2-x!"
    solve_ _ _ = error "Owibka v logike"

getResult :: (Result, Result) -> String
getResult ((a1, Just name1), (_, Nothing)) = name1
getResult ((a1, Just name1), (a2, Just name2))
    | a1 > a2 = name1
    | otherwise = name2

main = do
    n <- readLn::(IO Int)
    lines <- sequence (map (\x -> getLine) [1..n])
    putStrLn (solve lines)

import Data.List (sort, group)

main = do interact $ (++ "\n") . head . select . (++ [[]]) . group . sort . tail . lines
	where select l = if length (l!!0) > length (l!!1) then l!!0 else l!!1

{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
import List
data State s a = State {runState :: s->(a,s)}
instance Monad (State s) where
	return = State . (,)
	(State f1) >>= f2 = State $ uncurry (runState . f2) . f1
	(State f1) >> (State f2) = State $ f2 .snd . f1

repeatM a = mapM (const a) (repeat 1)
repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)
readchar = State (\s->(head s,tail s))
readall = State (,"")

runRead x s = fst $ runState x s

main = reader >>= writer . solver
reader = getContents
writer = putStr
solver = runRead $ do
	n<-readm
	all <- readall
	let l = take n . tail . lines $ all
	let teams = nub l
	return (if length teams == 1 then head teams else let [t1,t2]=teams in  if (length . filter (==t1) $ l) > (length . filter (==t2) $ l) then t1 else t2)

import Data.List
solve c = if length (filter (==head names) c)> length (filter (== last names) c) then
	         head names else last names
	 where names = nub c

main = do
	n<-getLine
	rest<-getContents
	putStrLn $ solve $ words rest

module Main(main) where

main = interact in2out

in2out input
  = output
  where
    (num, output) = solve (tail (words input))
    solve []
      = (-1, "")
    solve (x:xs)
      | num1 > num2
      = (num1, x)
      | otherwise
      = (num2, y)
      where
        num1 = length (filter (==x) xs)
        (num2, y) = solve xs

main = do nInput <- getLine
          str <- getContents
          putStrLn $ solver $ lines str

solver ss = if length t1 > length t2 then head t1 else head t2
    where
      ts = match ss ([], [])
      t1 = fst ts
      t2 = snd ts

match [] (x, y) = (x, y)
match (s:ss) ([], x) = match ss ([s], x)
match (s:ss) (x, y) = if s == head x then match ss (s:x, y) else match ss (x, s:y)

{-
err::(a->Bool)->a->a
err f a
 |f a = a
 | otherwise=undefined

predS::[String]->[String]
predS=err ((<10) . length). err (/="")

diff::Eq a=>[a]->Bool
diff []=False
diff (x:xs)=
-}
nInp::Int->IO [String]
nInp 0=return []
nInp n=do
  m <- getLine
  (m:) <$> nInp (n-1)

mf::[String]->String
mf l@(x:_)=head $ mymax length (filter (==x) l) (filter (== notThis x l) l)

notThis::(Eq a)=>a->[a]->a
notThis a []=a
notThis a (x:xs)
 |a==x = notThis a xs
 |otherwise = x

mymax::(a->Int)->a->a->a
mymax f a b
 |(f a)>= (f b) = a
 |otherwise = b

main::IO()
main=do
  n <- getLine
  inps <- nInp (read n)
  putStrLn $ mf inps

import Data.Map
import Data.List
main = interact (s.words)
s (n:xs) = sl empty xs where
  sl m [] = fst(maximumBy(\(_,v1)(_,v2)->compare v1 v2)(toList m))
  sl m (x:xs) = sl (insertWith (+) x 1 m) xs

main = readLn >>= readdata >>= putStr . solve
readdata 1 = getLine >>= \a -> return [a]
readdata n = do
    a <- getLine
    q <- readdata (n - 1)
    return (a : q)
solve sp = let a = length [x | x <- sp, x == head sp];
               b = length [x | x <- sp, x /= head sp];
           in if a > b then head sp else head [x | x <- sp, x /= head sp]

import Data.List (group, maximumBy, sort)
import Data.Ord (comparing)

main :: IO ()
main = getContents >>= putStrLn . solve . tail . lines

solve :: [String] -> String
solve = head . maximumBy (comparing length) . group . sort

import Data.List (foldl', maximumBy)
import Data.Ord (comparing)
import qualified Data.Map as M

main :: IO ()
main = getContents >>= putStrLn . solve . tail . lines

solve :: [String] -> String
solve = fst . maximumBy (comparing snd) . M.toList . foldl' (\m x -> M.insertWith (+) x (1 :: Integer) m) M.empty

import qualified Data.Map as M
main = putStrLn . fst . M.foldWithKey (\t s (t0,s0) -> if s > s0 then (t,s) else (t0,s0)) (undefined,0) .  M.fromListWith (+) . map (flip (,) 1) . tail . lines =<< getContents

import Data.List
import Data.Function
solve = head . maximumBy (compare `on` length) . group . sort
main = interact $ solve . tail . lines

import Data.List

main = do
    s <- getLine
    ds <- getContents
    let teams = map f . group . sort . lines $ ds
    putStrLn . snd . maximum $ teams
    where f x = (length x, head x)

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

readData :: [String] -> [String]
readData (x:xs) = take n xs
                    where n = read x

solve :: [String] -> String
solve list = sortedArray !! middleIndex
          where sortedArray = sort list
                middleIndex = (length list) `div` 2

main = interact$solve.readData.words

import List
main = interact solve
solve input = output where
  output = snd $ maximum $ zip ( map length $ group a ) ( nub a )
  a = sort $ tail $ lines input

import Control.Applicative
import Data.List

main= do
	getLine
	n<-   lines  <$> getContents ::IO [String]
	let s= group $ sort n
	let s1 = s++s
	let (a:b:c)= map length s1
	putStrLn $ if a > b then  head (head s) else head (last s)

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List

-- Meat
solve :: [String] -> [String]
solve xs  = [pickLongest . group . sort $ xs]

pickLongest :: [[String]] -> String
pickLongest [xs] = head xs
pickLongest [xs, ys] = if length xs > length ys then head xs else head ys
pickLongest _ = error "You suck"

-- Shit
main :: IO ()
main = do
        _:xs  <- readShit
        printShit $ solve xs

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: Bool -> x -> x -> x
iif True a _ = a
iif _ _ b = b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents


import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        s <- getLine
        print $ length $ foldl func [] s

func :: String -> Char -> String
func [] y = [y]
func s 'A' = 'A':s
func (_:xs) 'B' = xs
func _ _  = []

{-# LANGUAGE BangPatterns #-}

import Control.Monad

solve :: [Char] -> Int
solve = let
  go :: Int -> [Char] -> Int
  go k [] = k
  go 0 (_:qs) = go 1 qs
  go !k ('B':qs) = go (k-1) qs
  go !k (_:qs) = go (k+1) qs
  in  go 0

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    str <- getLine
    print $ solve str


module Main where
  inv :: Integer -> Integer
  inv 1 = 2
  inv 2 = 1

  partialSolver :: Integer -> Integer -> Integer
  partialSolver x prev
    | x `mod` 2 == 1  = prev
    | otherwise       = inv prev

  solver :: [Integer] -> Integer -> [Integer] -> [Integer]
  solver [] _ accumulator = accumulator
  solver (x:xs) prev (y:ys) =
    let ans = partialSolver x y
        in solver xs ans (ans:y:ys)

  solverWrapper :: [Integer] -> [Integer]
  solverWrapper xs = tail $ reverse $ solver xs 2 [2]

  readInt :: String -> Integer
  readInt x = read x :: Integer

  main :: IO()
  main = do
    n <- getLine
    queries <- getLine
    let xs = map readInt $ words queries
        answers =  solverWrapper xs
    mapM_ (putStrLn . show) answers

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    xs <- (map read . take n . words) `fmap` getContents :: IO [Int]
    solve xs 0

solve [] acc = return ()
solve (x:xs) acc
    | even x = do
        print $ if even acc then 1 else 2
        solve xs (acc+1)
    | otherwise = do
        print $ if even acc then 2 else 1
        solve xs acc

main :: IO ()
main = do
  nText <- getLine
  aText <- getLine
  let a = map read $ words aText :: [Int]
  mapM_ print (map winner (quicksum (map (\x -> x-1) a)))

winner :: Int -> Int
winner x = 2 - (x `mod` 2)

quicksum :: [Int] -> [Int]
quicksum x = qs 0 x

qs :: Int -> [Int] -> [Int]
qs _ [] = []
qs s (x:xs) = (x+s):(qs (x+s) xs)

main = getContents >>= ( putStrLn . concat . map (\x -> if mod x 2 /=  0 then "1\n" else "2\n") . tail . reverse . foldl (\x -> \y -> ((y + head x) : x)) [0] . map (\x -> x - 1) . map (\x -> read x :: Integer) . tail . words)
--

main = getContents >>= putStr . unlines . map show . solve 2 . map read . tail . words

solve :: Int -> [Int] -> [Int]
solve x [a] = if a `mod` 2 == 0
              then [3 - x]
              else [x]
solve x (a:as) = if a `mod` 2 == 0
                 then (3 - x) : solve (3 - x) as
                 else x : solve x as

main = putStr . unlines . map (show . (+1) . fromEnum) . tail . scanl (\r n -> r /= even n) True . map read . tail . words =<< getContents

main = getContents >>= ( putStrLn . concat . map (\x -> if x == True then "1\n" else "2\n") . tail . reverse . foldr (\y -> \x -> ((y /= head x) : x)) [False] . map (\x -> mod (x - 1) 2 /= 0) . map read . tail . words)

main = getContents >>= ( putStrLn . concat . map (\x -> if x == True then "1\n" else "2\n") . tail . reverse . foldr (\y -> \x -> ((y /= head x) : x)) [False] . map (\x -> mod x 2 == 0) . map read . tail . words)

main = getContents >>= ( putStrLn . concat . map (\x -> if mod x 2 /=  0 then "1\n" else "2\n") . tail . reverse . foldr (\y -> \x -> ((y + head x) : x)) [0] . map (\x -> x - 1) . map (\x -> read x :: Integer) . tail . words)


import Control.Monad
import Data.List

calc' :: [Int] -> [Int] -> [Int] -> [Int]
calc' [] hd tl = hd ++ (reverse tl)
calc' (x:xs) [] tl = calc' xs [x] tl
calc' (x:xs) hd@(h:hs) tl | x < h = calc' xs (x:hd) tl
calc' (x:xs) hd tl | otherwise = calc' xs hd (x:tl)

calc :: [Int] -> [Int]
calc lst = calc' lst [] []

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    line <- getLine
    let lst = map read $ words line :: [Int]
    putStrLn $ intercalate " " $ map show $ calc lst

--
-- 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 -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad

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

    (putStr . unlines . map (concatMap ((++ " ") . show) . solve)) tcs

getTC = do
    n <- readLn
    map read <$> wordsN n <$> getLine     :: IO [Int]

wordsN n s = ww  where  w = words s; ww | (length w == n) = w
                                        | otherwise = error "arr len"

solve = f ([],[])
  where
    f (xs  , ys   ) []                  = xs ++ reverse ys
    f ([]  , []   ) (z:zs)              = f ([z]   , []  ) zs
    f (x:xs, ys   ) (z:zs) | (z < x)    = f (z:x:xs, ys  ) zs
                           | (z > x)    = f (x:xs  , z:ys) zs
                           | otherwise  = error "not a permutation"
    f ([]  , (_:_)) (_:_)               = error "xs must be first"

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

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    p <- getInts n
    let
      initVals = Set.fromDistinctAscList [1..n]
      solve :: Set.IntSet -> [Int] -> [Int] -> [Int]
      solve _nil [] cont = cont
      solve vals (x:xs) cont = if  x == Set.findMin vals
        then  x : solve (Set.delete x vals) xs cont
        else  solve (Set.delete x vals) xs (x : cont)
    pure $ putInts $ solve initVals (reverse p) []

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

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

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

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

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


main = do
    str1 <- getLine
    str2 <- getLine
    putStr (f (read ((words str1) !! 1)) (map read (words str2)))

f x xs
 | x==1         = "YES"
 | x<1          = "NO"
 | otherwise    = f (x - (head xs)) (drop (head xs) xs)

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[_, t], as] = go t as
  where go 1 _ = True
        go n _ | n < 1 = False
        go n xs@(x:_) = go (n - x) (drop x xs)
        go _ _ = False

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Data.Array
main = do
  [n,t] <- fmap (map read . words) getLine
  as <- fmap (listArray (1,n) . map read . words) getLine
  let go i | i > t = "NO"
           | i == t = "YES"
           | otherwise = go (i + (as ! i))
  putStrLn $ go 1

-- Vicfred
-- https://codeforces.com/problemset/problem/500/A

solve :: Int -> [Int] -> Bool
solve 1 _   = True
solve _ []  = False
solve t a@(h:_) = solve (t-h) (drop h a)

main :: IO ()
main = do
    [_, t] <- map read . words <$> getLine :: IO [Int]
    a <- map read . words <$> getLine :: IO [Int]
    putStrLn $ if solve t a then "YES" else "NO"

p b = if b then "YES" else "NO"
f (t:ps) = loop 1
  where
    loop x | t == x    = True
           | x > t     = False
           | otherwise = loop (x + (ps !! (x-1)))
main = interact $ p . f . tail . map read . words

module Main where

import Data.Array ((!), array)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

readCells n = buildCells n `fmap` readNumbers

buildCells n =  zip [(1 :: Int)..] . take n

buildPortals n cells =
  array (1, pred n) [ (i, ai + i) | (i, ai) <- cells ]

navigatePortals n portals destination =
    go 1
  where
    go current
      | current > destination = False
      | current == destination = True
      | current > n = False
      | otherwise = go (portals ! current)

main :: IO ()
main = do
  (n:destination:_) <- readNumbers
  cells <- readCells n
  putStrLn (if navigatePortals n (buildPortals n cells) destination
              then "YES"
              else "NO")

main = do
    constraints <- getLine
    lineSystem <- getLine

    let [_, destination] = readInts constraints
        portals = zip (readInts lineSystem ++ [0]) [1..]

    putStrLn $ result portals destination

readInts :: String -> [Int]
readInts = map read . words

result :: [(Int, Int)] -> Int -> String
result [] _ = "NO"
result (x:xs) dest
  | index == dest = "YES"
  | index > dest  = "NO"
  | otherwise     = result (drop jump (x:xs)) dest
  where (jump, index) = x

main = do
    constraints <- getLine
    lineSystem <- getLine

    let [_, destination] = readInts constraints
        portals = zip (readInts lineSystem ++ [0]) [1..]

    putStrLn $ result portals destination

readInts = map read . words

result [] _ = "NO"
result (x:xs) dest
  | index == dest = "YES"
  | index > dest  = "NO"
  | otherwise     = result (drop jump (x:xs)) dest
  where (jump, index) = x

import Control.Applicative
import Data.List
import Data.Array

process d b = process1 1
	where process1 n | n==b = "YES"
	      		 | n>b = "NO"
                         | otherwise = process1 (n+d!n)

main= do
	[a,b]<- map read. words <$> getLine::IO [Int]
	c<- map read. words <$> getLine::IO [Int]
	let d = listArray (1,a) c
	putStrLn $ process d b

import Control.Applicative
import Data.List
import Data.Array

process d b n | n==b = "YES"
	      | n>b = "NO"
              | otherwise = process d b (n+d!n)

main= do
	[a,b]<- map read. words <$> getLine::IO [Int]
	c<- map read. words <$> getLine::IO [Int]
	let d = listArray (1,a) c
	putStrLn $ process d b 1

import Control.Applicative
import Data.List

process c b n | n==b = "YES"
	      | n>b = "NO"
              | otherwise = process c b (n+c!!(n-1))

main= do
	[a,b]<- map read. words <$> getLine::IO [Int]
	c<- map read. words <$> getLine::IO [Int]
	putStrLn $ process c b 1

-- http://codeforces.com/problemset/problem/500/A

isReachingOutPossible end cells = traverse end cells [1]
  where
    traverse end cells (y:[])
      | end == y = "YES"
      | end > y = traverse end cells [newRes]
      | end < y = "NO"
      where
        newRes = y + (cells !! (y - 1))

main = do
  constraint <- getLine
  cells <- getLine

  let newConstraint = map (read :: String -> Int) $ words constraint
  let destination = newConstraint !! 1
  let lineWorld = map (read :: String -> Int) $ words cells

  let result = isReachingOutPossible destination lineWorld
  putStrLn result

main = do
  l <- getLine
  p <- getLine
  let (n:t:[]) = map read (words l) :: [Int]
  let paths = map read (words p) :: [Int]
  putStrLn $ if dfs n 0 (t-1) paths
    then "YES"
    else "NO"

dfs :: Int -> Int -> Int -> [Int] -> Bool
dfs n pos goal paths
  | pos == goal = True
  | pos > goal = False
  | otherwise = dfs n (pos + (paths !! pos)) goal paths

import Data.Graph

process :: Int -> Int -> [Int] -> Bool
process n t xs = path g 1 t
    where g = buildG (1,n) $ zipWith (\i x -> (i,i+x)) [1..] xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,t] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    putStrLn $ ["NO","YES"] !! fromEnum (process n t as)

reach 0 _ = "YES"
reach _ [] = "NO"
reach t (a:ais)
  | t > 0 = reach (t - a) $ drop (a - 1) ais
  | otherwise = "NO"

solve str =
  let (n:t:ais) = (map read . words) str
  in reach (t - 1) ais

main = interact solve

main = interact $ f . map read . words

f (_:t:s) = v 1 s
    where v c a | c ==t = "YES"
                | c > t = "NO"
                | otherwise = v (c+x) $ drop x a
                              where x = head a

import Data.Char
import qualified Data.Set as S

import qualified Data.List as L

{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-name-shadowing #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HashTable
-- Copyright   :  (c) The University of Glasgow 2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- An implementation of extensible hash tables, as described in
-- Per-Ake Larson, /Dynamic Hash Tables/, CACM 31(4), April 1988,
-- pp. 446--457.  The implementation is also derived from the one
-- in GHC's runtime system (@ghc\/rts\/Hash.{c,h}@).
--
-----------------------------------------------------------------------------
{-
module Data.HashTable
      {-# DEPRECATED "Data.HashTable will be removed in GHC 7.8. Please use an alternative, e.g. the hashtables package, instead." #-}
      (
        -- * Basic hash table operations
        HashTable, new, newHint, insert, delete, lookup, update,
        -- * Converting to and from lists
        fromList, toList,
        -- * Hash functions
        -- $hash_functions
        hashInt, hashString,
        prime,
        -- * Diagnostics
        longestChain
 ) where
-}
-- This module is imported by Data.Dynamic, which is pretty low down in the
-- module hierarchy, so don't import "high-level" modules

import GHC.Base

import Prelude  hiding  ( lookup )

import Data.Tuple       ( fst )
import Data.Bits
import Data.Maybe
import Data.List        ( maximumBy, length, concat, foldl', partition )
import Data.Int         ( Int32 )

import GHC.Num
import GHC.Real         ( fromIntegral )
import GHC.Show         ( Show(..) )
import GHC.Int          ( Int64 )

import GHC.IO
import GHC.IOArray
import GHC.IORef

import Data.Char        ( ord )
import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
import System.IO.Unsafe ( unsafePerformIO )
import Data.Int         ( Int64 )

--import Hugs.IOArray     ( IOArray, newIOArray,
 --                         unsafeReadIOArray, unsafeWriteIOArray )

--import NHC.IOExtras     ( IOArray, newIOArray, readIOArray, writeIOArray )

import Control.Monad    ( mapM, mapM_, sequence_ )

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

iNSTRUMENTED :: Bool
iNSTRUMENTED = False

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

readHTArray  :: HTArray a -> Int32 -> IO a
writeMutArray :: MutArray a -> Int32 -> a -> IO ()
newMutArray   :: (Int32, Int32) -> a -> IO (MutArray a)
newMutArray = newIOArray
type MutArray a = IOArray Int32 a
type HTArray a = MutArray a
-- #if defined(DEBUG) || defined(__NHC__)
--readHTArray  = readIOArray
--writeMutArray = writeIOArray
-- #else
readHTArray arr i = unsafeReadIOArray arr (fromIntegral i)
writeMutArray arr i x = unsafeWriteIOArray arr (fromIntegral i) x
-- #endif

data HashTable key val = HashTable {
                                     cmp     :: !(key -> key -> Bool),
                                     hash_fn :: !(key -> Int32),
                                     tab     :: !(IORef (HT key val))
                                   }
-- TODO: the IORef should really be an MVar.

data HT key val
  = HT {
        kcount  :: !Int32,              -- Total number of keys.
        bmask   :: !Int32,
        buckets :: !(HTArray [(key,val)])
       }

-- ------------------------------------------------------------
-- Instrumentation for performance tuning

-- This ought to be roundly ignored after optimization when
-- iNSTRUMENTED=False.

-- STRICT version of modifyIORef!
modifyIORef :: IORef a -> (a -> a) -> IO ()
modifyIORef r f = do
  v <- readIORef r
  let z = f v in z `seq` writeIORef r z

data HashData = HD {
  tables :: !Integer,
  insertions :: !Integer,
  lookups :: !Integer,
  totBuckets :: !Integer,
  maxEntries :: !Int32,
  maxChain :: !Int,
  maxBuckets :: !Int32
} deriving (Eq, Show)

{-# NOINLINE hashData #-}
hashData :: IORef HashData
hashData =  unsafePerformIO (newIORef (HD { tables=0, insertions=0, lookups=0,
                                            totBuckets=0, maxEntries=0,
                                            maxChain=0, maxBuckets=tABLE_MIN } ))

instrument :: (HashData -> HashData) -> IO ()
instrument i | iNSTRUMENTED = modifyIORef hashData i
             | otherwise    = return ()

recordNew :: IO ()
recordNew = instrument rec
  where rec hd@HD{ tables=t, totBuckets=b } =
               hd{ tables=t+1, totBuckets=b+fromIntegral tABLE_MIN }

recordIns :: Int32 -> Int32 -> [a] -> IO ()
recordIns i sz bkt = instrument rec
  where rec hd@HD{ insertions=ins, maxEntries=mx, maxChain=mc } =
               hd{ insertions=ins+fromIntegral i, maxEntries=mx `max` sz,
                   maxChain=mc `max` length bkt }

recordResize :: Int32 -> Int32 -> IO ()
recordResize older newer = instrument rec
  where rec hd@HD{ totBuckets=b, maxBuckets=mx } =
               hd{ totBuckets=b+fromIntegral (newer-older),
                   maxBuckets=mx `max` newer }

recordLookup :: IO ()
recordLookup = instrument lkup
  where lkup hd@HD{ lookups=l } = hd{ lookups=l+1 }

-- stats :: IO String
-- stats =  fmap show $ readIORef hashData

-- ----------------------------------------------------------------------------
-- Sample hash functions

-- $hash_functions
--
-- This implementation of hash tables uses the low-order /n/ bits of the hash
-- value for a key, where /n/ varies as the hash table grows.  A good hash
-- function therefore will give an even distribution regardless of /n/.
--
-- If your keyspace is integrals such that the low-order bits between
-- keys are highly variable, then you could get away with using 'fromIntegral'
-- as the hash function.
--
-- We provide some sample hash functions for 'Int' and 'String' below.

golden :: Int32
golden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32
-- was -1640531527 = round ((sqrt 5 - 1) * 2^31) :: Int32
-- but that has bad mulHi properties (even adding 2^32 to get its inverse)
-- Whereas the above works well and contains no hash duplications for
-- [-32767..65536]

hashInt32 :: Int32 -> Int32
hashInt32 x = mulHi x golden + x

-- | A sample (and useful) hash function for Int and Int32,
-- implemented by extracting the uppermost 32 bits of the 64-bit
-- result of multiplying by a 33-bit constant.  The constant is from
-- Knuth, derived from the golden ratio:
--
-- > golden = round ((sqrt 5 - 1) * 2^32)
--
-- We get good key uniqueness on small inputs
-- (a problem with previous versions):
--  (length $ group $ sort $ map hashInt [-32767..65536]) == 65536 + 32768
--
hashInt :: Int -> Int32
hashInt x = hashInt32 (fromIntegral x)

-- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply
mulHi :: Int32 -> Int32 -> Int32
mulHi a b = fromIntegral (r `shiftR` 32)
   where r :: Int64
         r = fromIntegral a * fromIntegral b

-- | A sample hash function for Strings.  We keep multiplying by the
-- golden ratio and adding.  The implementation is:
--
-- > hashString = foldl' f golden
-- >   where f m c = fromIntegral (ord c) * magic + hashInt32 m
-- >         magic = 0xdeadbeef
--
-- Where hashInt32 works just as hashInt shown above.
--
-- Knuth argues that repeated multiplication by the golden ratio
-- will minimize gaps in the hash space, and thus it's a good choice
-- for combining together multiple keys to form one.
--
-- Here we know that individual characters c are often small, and this
-- produces frequent collisions if we use ord c alone.  A
-- particular problem are the shorter low ASCII and ISO-8859-1
-- character strings.  We pre-multiply by a magic twiddle factor to
-- obtain a good distribution.  In fact, given the following test:
--
-- > testp :: Int32 -> Int
-- > testp k = (n - ) . length . group . sort . map hs . take n $ ls
-- >   where ls = [] : [c : l | l <- ls, c <- ['\0'..'\xff']]
-- >         hs = foldl' f golden
-- >         f m c = fromIntegral (ord c) * k + hashInt32 m
-- >         n = 100000
--
-- We discover that testp magic = 0.

hashString :: String -> Int32
hashString = foldl' f golden
   where f m c = fromIntegral (ord c) * magic + hashInt32 m
         magic = 0xdeadbeef

-- | A prime larger than the maximum hash table size
prime :: Int32
prime = 33554467

-- -----------------------------------------------------------------------------
-- Parameters

tABLE_MAX :: Int32
tABLE_MAX  = 32 * 1024 * 1024   -- Maximum size of hash table
tABLE_MIN :: Int32
tABLE_MIN  = 8

hLOAD :: Int32
hLOAD = 7                       -- Maximum average load of a single hash bucket

hYSTERESIS :: Int32
hYSTERESIS = 64                 -- entries to ignore in load computation

{- Hysteresis favors long association-list-like behavior for small tables. -}

-- -----------------------------------------------------------------------------
-- Creating a new hash table

-- | Creates a new hash table.  The following property should hold for the @eq@
-- and @hash@ functions passed to 'new':
--
-- >   eq A B  =>  hash A == hash B
--
new
  :: (key -> key -> Bool)    -- ^ @eq@: An equality comparison on keys
  -> (key -> Int32)          -- ^ @hash@: A hash function on keys
  -> IO (HashTable key val)  -- ^ Returns: an empty hash table

new cmpr hash = do
  recordNew
  -- make a new hash table with a single, empty, segment
  let mask = tABLE_MIN-1
  bkts <- newMutArray (0,mask) []

  let
    kcnt = 0
    ht = HT {  buckets=bkts, kcount=kcnt, bmask=mask }

  table <- newIORef ht
  return (HashTable { tab=table, hash_fn=hash, cmp=cmpr })

{-
   bitTwiddleSameAs takes as arguments positive Int32s less than maxBound/2 and
   returns the smallest power of 2 that is greater than or equal to the
   argument.
   http://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2
-}
bitTwiddleSameAs :: Int32 -> Int32
bitTwiddleSameAs v0 =
    let v1 = v0-1
        v2 = v1 .|. (v1`shiftR`1)
        v3 = v2 .|. (v2`shiftR`2)
        v4 = v3 .|. (v3`shiftR`4)
        v5 = v4 .|. (v4`shiftR`8)
        v6 = v5 .|. (v5`shiftR`16)
    in v6+1

{-
  powerOver takes as arguments Int32s and returns the smallest power of 2
  that is greater than or equal to the argument if that power of 2 is
  within [tABLE_MIN,tABLE_MAX]
-}
powerOver :: Int32 -> Int32
powerOver n =
    if n <= tABLE_MIN
    then tABLE_MIN
    else if n >= tABLE_MAX
         then tABLE_MAX
         else bitTwiddleSameAs n

-- | Creates a new hash table with the given minimum size.
newHint
  :: (key -> key -> Bool)    -- ^ @eq@: An equality comparison on keys
  -> (key -> Int32)          -- ^ @hash@: A hash function on keys
  -> Int                     -- ^ @minSize@: initial table size
  -> IO (HashTable key val)  -- ^ Returns: an empty hash table

newHint cmpr hash minSize = do
  recordNew
  -- make a new hash table with a single, empty, segment
  let mask = powerOver $ fromIntegral minSize
  bkts <- newMutArray (0,mask) []

  let
    kcnt = 0
    ht = HT {  buckets=bkts, kcount=kcnt, bmask=mask }

  table <- newIORef ht
  return (HashTable { tab=table, hash_fn=hash, cmp=cmpr })

-- -----------------------------------------------------------------------------
-- Inserting a key\/value pair into the hash table

-- | Inserts a key\/value mapping into the hash table.
--
-- Note that 'insert' doesn't remove the old entry from the table -
-- the behaviour is like an association list, where 'lookup' returns
-- the most-recently-inserted mapping for a key in the table.  The
-- reason for this is to keep 'insert' as efficient as possible.  If
-- you need to update a mapping, then we provide 'update'.
--
insert :: HashTable key val -> key -> val -> IO ()

insert ht key val =
  updatingBucket CanInsert (\bucket -> ((key,val):bucket, 1, ())) ht key

-- ------------------------------------------------------------
-- The core of the implementation is lurking down here, in findBucket,
-- updatingBucket, and expandHashTable.

tooBig :: Int32 -> Int32 -> Bool
tooBig k b = k-hYSTERESIS > hLOAD * b

-- index of bucket within table.
bucketIndex :: Int32 -> Int32 -> Int32
bucketIndex mask h = h .&. mask

-- find the bucket in which the key belongs.
-- returns (key equality, bucket index, bucket)
--
-- This rather grab-bag approach gives enough power to do pretty much
-- any bucket-finding thing you might want to do.  We rely on inlining
-- to throw away the stuff we don't want.  I'm proud to say that this
-- plus updatingBucket below reduce most of the other definitions to a
-- few lines of code, while actually speeding up the hashtable
-- implementation when compared with a version which does everything
-- from scratch.
{-# INLINE findBucket #-}
findBucket :: HashTable key val -> key -> IO (HT key val, Int32, [(key,val)])
findBucket HashTable{ tab=ref, hash_fn=hash} key = do
  table@HT{ buckets=bkts, bmask=b } <- readIORef ref
  let indx = bucketIndex b (hash key)
  bucket <- readHTArray bkts indx
  return (table, indx, bucket)

data Inserts = CanInsert
             | Can'tInsert
             deriving (Eq)

-- updatingBucket is the real workhorse of all single-element table
-- updates.  It takes a hashtable and a key, along with a function
-- describing what to do with the bucket in which that key belongs.  A
-- flag indicates whether this function may perform table insertions.
-- The function returns the new contents of the bucket, the number of
-- bucket entries inserted (negative if entries were deleted), and a
-- value which becomes the return value for the function as a whole.
-- The table sizing is enforced here, calling out to expandSubTable as
-- necessary.

-- This function is intended to be inlined and specialized for every
-- calling context (eg every provided bucketFn).
{-# INLINE updatingBucket #-}

updatingBucket :: Inserts -> ([(key,val)] -> ([(key,val)], Int32, a)) ->
                  HashTable key val -> key ->
                  IO a
updatingBucket canEnlarge bucketFn
               ht@HashTable{ tab=ref, hash_fn=hash } key = do
  (table@HT{ kcount=k, buckets=bkts, bmask=b },
   indx, bckt) <- findBucket ht key
  (bckt', inserts, result) <- return $ bucketFn bckt
  let k' = k + inserts
      table1 = table { kcount=k' }
  writeMutArray bkts indx bckt'
  table2 <- if canEnlarge == CanInsert && inserts > 0 then do
               recordIns inserts k' bckt'
               if tooBig k' b
                  then expandHashTable hash table1
                  else return table1
            else return table1
  writeIORef ref table2
  return result

expandHashTable :: (key -> Int32) -> HT key val -> IO (HT key val)
expandHashTable hash table@HT{ buckets=bkts, bmask=mask } = do
   let
      oldsize = mask + 1
      newmask = mask + mask + 1
   recordResize oldsize (newmask+1)
   --
   if newmask > tABLE_MAX-1
      then return table
      else do
   --
    newbkts <- newMutArray (0,newmask) []

    let
     splitBucket oldindex = do
       bucket <- readHTArray bkts oldindex
       let (oldb,newb) =
              partition ((oldindex==). bucketIndex newmask . hash . fst) bucket
       writeMutArray newbkts oldindex oldb
       writeMutArray newbkts (oldindex + oldsize) newb
    mapM_ splitBucket [0..mask]

    return ( table{ buckets=newbkts, bmask=newmask } )

-- -----------------------------------------------------------------------------
-- Deleting a mapping from the hash table

-- Remove a key from a bucket
deleteBucket :: (key -> Bool) -> [(key,val)] -> ([(key, val)], Int32, ())
deleteBucket _   [] = ([],0,())
deleteBucket del (pair@(k,_):bucket) =
  case deleteBucket del bucket of
    (bucket', dels, _) | del k     -> dels' `seq` (bucket', dels', ())
                       | otherwise -> (pair:bucket', dels, ())
      where dels' = dels - 1

-- | Remove an entry from the hash table.
delete :: HashTable key val -> key -> IO ()

delete ht@HashTable{ cmp=eq } key =
  updatingBucket Can'tInsert (deleteBucket (eq key)) ht key

-- -----------------------------------------------------------------------------
-- Updating a mapping in the hash table

-- | Updates an entry in the hash table, returning 'True' if there was
-- already an entry for this key, or 'False' otherwise.  After 'update'
-- there will always be exactly one entry for the given key in the table.
--
-- 'insert' is more efficient than 'update' if you don't care about
-- multiple entries, or you know for sure that multiple entries can't
-- occur.  However, 'update' is more efficient than 'delete' followed
-- by 'insert'.
update :: HashTable key val -> key -> val -> IO Bool

update ht@HashTable{ cmp=eq } key val =
  updatingBucket CanInsert
    (\bucket -> let (bucket', dels, _) = deleteBucket (eq key) bucket
                in  ((key,val):bucket', 1+dels, dels/=0))
    ht key

-- -----------------------------------------------------------------------------
-- Looking up an entry in the hash table

-- | Looks up the value of a key in the hash table.
lookup :: HashTable key val -> key -> IO (Maybe val)

lookup ht@HashTable{ cmp=eq } key = do
  recordLookup
  (_, _, bucket) <- findBucket ht key
  let firstHit (k,v) r | eq key k  = Just v
                       | otherwise = r
  return (foldr firstHit Nothing bucket)

-- -----------------------------------------------------------------------------
-- Converting to/from lists

-- | Convert a list of key\/value pairs into a hash table.  Equality on keys
-- is taken from the Eq instance for the key type.
--
fromList :: (Eq key) => (key -> Int32) -> [(key,val)] -> IO (HashTable key val)
fromList hash list = do
  table <- new (==) hash
  sequence_ [ insert table k v | (k,v) <- list ]
  return table

-- | Converts a hash table to a list of key\/value pairs.
--
toList :: HashTable key val -> IO [(key,val)]
toList = mapReduce id concat

{-# INLINE mapReduce #-}
mapReduce :: ([(key,val)] -> r) -> ([r] -> r) -> HashTable key val -> IO r
mapReduce m r HashTable{ tab=ref } = do
  HT{ buckets=bckts, bmask=b } <- readIORef ref
  fmap r (mapM (fmap m . readHTArray bckts) [0..b])

-- -----------------------------------------------------------------------------
-- Diagnostics

-- | This function is useful for determining whether your hash
-- function is working well for your data set.  It returns the longest
-- chain of key\/value pairs in the hash table for which all the keys
-- hash to the same bucket.  If this chain is particularly long (say,
-- longer than 14 elements or so), then it might be a good idea to try
-- a different hash function.
--
longestChain :: HashTable key val -> IO [(key,val)]
longestChain = mapReduce id (maximumBy lengthCmp)
  where lengthCmp (_:x)(_:y) = lengthCmp x y
        lengthCmp []   []    = EQ
        lengthCmp []   _     = LT
        lengthCmp _    []    = GT

type Graph = HashTable Int (S.Set Int)

type Queue = [Int]

enqueue' :: Int -> Queue -> IO Queue
enqueue' x s = return (s++[x])

enqueue :: Int -> Queue -> IO Queue
enqueue x s = do s <- enqueue' x s
	         return s

pop :: Queue -> IO (Int,Queue)
pop (x:xs) = return (x,xs)

newGraph :: IO Graph
newGraph = new (\x y -> x == y) (\x -> hashInt x)

ginsert :: Int -> Graph -> IO ()
ginsert v g = insert g v (S.empty)

ginsertEdge :: Int -> Int -> Graph -> IO ()
ginsertEdge v v' g = do maybeset1 <- lookup g v
		        maybeset2 <- lookup g v'
		        case maybeset1 of
			    Nothing -> return ()
			    Just set1 -> case maybeset2 of
				 Nothing -> return ()
				 Just set2 -> do b1 <- update g v (S.insert v' set1)
						 b2 <- update g v' (S.insert v set2)
						 return ()

ginsertEdgeDir :: Int -> Int -> Graph -> IO ()
ginsertEdgeDir v v' g = do maybeset1 <- lookup g v
			   maybeset2 <- lookup g v'
		           case maybeset1 of
			       Nothing -> return ()
			       Just set1 -> case maybeset2 of
				    Nothing -> return ()
				    Just set2 -> do b1 <- update g v (S.insert v' set1)
						    return ()
gprintGraph :: Graph -> IO ()
gprintGraph g = do xs <- toList g
		   print xs

putQueue :: S.Set Int -> Queue -> IO Queue
putQueue set q = return (L.nub (q ++ S.elems set))

bfs'' :: Graph -> Queue -> S.Set Int -> IO [Int]
bfs'' g [] visited = return []
bfs'' g q visited = do (i',q') <- pop q
		       if S.notMember i' visited then(do maybeset <- lookup g i'
					                 case maybeset of
						             Nothing -> return []
						             Just set ->(do q <- putQueue set q
									    xs <- bfs'' g q (S.insert i' visited)
									    return (i':xs)))
						 else(do xs <- bfs'' g q' visited
							 return xs)

bfs' :: Int -> Graph -> Queue -> IO [Int]
bfs' i g q = do q <- putQueue (S.singleton i) q
		xs <- bfs'' g q S.empty
		return xs

bfs :: Int -> Graph -> IO [Int]
bfs i g = bfs' i g []

insertCells :: Int -> Graph -> IO ()
insertCells 1 g = do ginsert 1 g
		     return ()
insertCells n g = do ginsert n g
		     insertCells (n-1) g

insertPortals :: Int -> [Int] -> Int -> Graph -> IO ()
insertPortals i [] n g = return ()
insertPortals i (x:xs) n g = if i <= n then do ginsertEdgeDir i (i+x) g
			    		       insertPortals (i+1) xs n g
			     else return ()

makeList :: Int -> String -> [Int]
makeList 0 s = []
makeList n [] = []
makeList n (' ':s) = makeList n s
makeList n s = let (snumber,s') = span isDigit s
		   number = read snumber :: Int in number:(makeList (n-1) s')

main :: IO ()
main = do s <- getLine
	  s' <- getLine
	  let (sn,s1) = span isDigit s
	      (st,s2) = span isDigit (tail s1)
	      n = read sn :: Int
	      t = read st :: Int
	      xs = makeList (n-1) s' in do g <- newGraph
					   insertCells n g
					   insertPortals 1 xs n g
					   xs <- bfs 1 g
					   if (L.elem t xs) then putStrLn "YES" else putStrLn "NO"

import Data.List

canReach :: [Int] -> Int -> String
canReach xs dest
    | dest == 0 = "YES"
    | dest <  0 = "NO"
    | otherwise = canReach (drop jump xs) (dest - jump)
    where jump = head xs

solve :: String -> String
solve s = canReach xs (dest - 1)
    where (_:dest:xs) = fmap read. words $ s

main :: IO ()
main= interact $ solve

solve :: [Int] -> Int -> Int -> String
solve ports cur dest
  | cur == dest = "YES"
  | cur > dest = "NO"
  | otherwise = solve (drop (head ports) ports) (cur + (head ports)) dest

main = do
  inp <- getLine
  let [n, x] = map read (words inp)
  inp <- getLine
  let a = map read $ words inp
  putStrLn $ solve a 1 x

module Main where

data Tree a = EmptyTree | Tree (Tree a) (Tree a) a

data Vector a = Vector Int (Tree a)
(!)::Vector a -> Int -> a
(!) (Vector n t) i = get 0 (n - 1) t i
    where get l r (Tree lc rc v) i | i < m     = get l (m - 1) lc i
                                   | i > m     = get (m + 1) r rc i
                                   | otherwise = v
              where m = div (l + r) 2
generate::Int -> (Int -> a) -> Vector a
generate n f = Vector n (gen 0 (n - 1) f)
         where gen l r f | l >　r     = EmptyTree
                         | otherwise = Tree (gen l (m - 1) f) (gen (m + 1) r f) (f m)
                   where m = div (l + r) 2
fromListN::Int -> [a] -> Vector a
fromListN n an = Vector n (fst (gen 0 (n - 1) an))
          where gen l r an | l >　r     = (EmptyTree, an)
                           | otherwise = let (lc,(v:an'))  = gen l (m - 1) an
                                             (rc,an'') = (gen (m + 1) r an')
                                         in (Tree lc rc v, an'')
                    where m = div (l + r) 2

solveA n t an = if visitable ! 0 then "YES" else "NO"
       where visitable = generate n f
             f x |　x > t      = False
                 | x == t     = True
                 | otherwise  = f (x + (an ! x))

taskA = do input <- getContents
           let (n:t:an) = Prelude.map (read::String->Int) $ words input
           putStrLn $ solveA n (t - 1) (fromListN (n - 1) an)

main = taskA

import Data.Array
main = do
 [n,t] <- words `fmap`getLine

 a <-getLine
 let portal=array (1,(read n)-1) $ zip [1..(read n)-1] (map read $words a)
 putStrLn $ canIpass (read n) (read t) portal

-- portal from i to i+ai

possiblePosition::Int->Int->Array Int Int->[Int]
possiblePosition 0 _ _ = []
possiblePosition count currPos portals
 | currPos<=snd (bounds portals) = [currPos+portals!currPos] ++
    possiblePosition (count-1) (currPos+portals!currPos) portals
 | otherwise = []

canIpass::Int->Int->Array Int Int->String
canIpass count endPos portals  =
 if endPos `elem` (possiblePosition count 1 portals)
  then "YES"
  else "NO"

import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.ByteString.Char8 as B

readListLn :: IO [Int]
readListLn = (map (fst . fromJust . B.readInt) . B.words) `liftM` B.getLine

guess :: Int -> Array Int Int -> Bool
guess t arr = first == t
    where
        first = head $ dropWhile (<t) $ iterate step 1
        step k = k + arr ! k

main :: IO ()

main = do
    [n, t] <- readListLn
    a <- (++[0]) `liftM` readListLn
    if guess t (listArray (1, n) a) then putStr "YES"
                                      else putStr "NO"

import Data.Array

main = do
  [n, t] <- fmap (map read . words) getLine
  as <- fmap (map read . words) getLine

  let
    a = array (1, n) $ zipWith (\a i -> (i, i+a)) as [1..] ++ [(n, n)]

    find u
      | u == t = True
      | v == u = False
      | otherwise = find v
      where v = a!u

  putStrLn $ if find 1 then "YES" else "NO"

main = interact $ f . map read . words
f (n:t:a) | t == 1 = "YES"
f (n:t:a:b) = f (n:t - a:drop (a - 1) b)
f _ = "NO"

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,t) <- readIntPair
    as <- readInts
    case solve n t as of
        True -> putStrLn "YES"
        False -> putStrLn "NO"

solve :: Int -> Int -> [Int] -> Bool
solve n t as = go 1 where
    g :: UArray Int Int
    g = array (1,n-1) [ (i,i+ai) | (i,ai) <- zip [1..] as]
    go p | p == t = True
         | p > t  = False
         | otherwise = go (g ! p)

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =   interact $ solve.map (map read.words).take 2 . lines
solve :: [[Int]]->String
solve [[_,x],ys] = slv1 0
  where slv1 ot | ot < x-1      = slv1 (ot+(ys !! ot))
                | ot == x-1     = "YES"
                | otherwise   = "NO"

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

solve :: Int -> [Int] -> Bool
solve 1 _  = True
solve _ [] = False
solve t a@(h:_) = t >= 1 && solve (t - h) (drop h a)

main :: IO ()
main = do
        [_, t] <- getIntList
        a <- getIntList
        putStrLn $ if solve t a then "YES" else "NO"

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

process c f a | c==f = "YES"
              | c>f = "NO"
              | otherwise = process (c+a!!c) f a

main=do
   [n,m]<- map read <$> words <$>  getLine:: IO [Int]
   a<- map read <$> words <$> getLine ::IO [Int]
   putStrLn $ process 0 (m-1) a

main = interact $ f 1 . map read . words
f x [n,t] = "NO"
f x (n:t:a:b) | x == t = "YES"
              | otherwise = f (x + a) (n:t:drop (a - 1) b)

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =   interact $ solve.map (map read.words).take 2 . lines
solve :: [[Int]]->String
solve [[_,x],ys] = slv1 1
  where slv1 ot | ot < x      = slv1 (ot+(ys !! ot)+1)
                | ot == x     = "YES"
                | otherwise   = "NO"

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

process c f a | c==f = "YES"
              | c>f = "NO"
              | otherwise = process (c+a!!c) f a

main=do
   [n,m]<- map read <$> words <$>  getLine:: IO [Int]
   a<- map read <$> words <$> getLine ::IO [Int]
   print $ process 0 (m-1) a

main=interact$show.f.map read.words
f(a:x:xs)
 | x==1         = "YES"
 | x<1          = "NO"
 | otherwise    = f([a] ++ [x - (head xs)] ++ (drop (head xs) xs))

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[_, t], as] = go t as
  where go 0 _ = True
        go n _ | n < 0 = False
        go n (x:xs) = go (n - x) (drop x xs)
        go _ _ = False

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[_, t], as] = go t as
  where go 0 _ = True
        go n _ | n < 0 = False
        go n xs@(x:_) = go (n - x) (drop x xs)
        go _ _ = False

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

-- Vicfred
-- https://codeforces.com/problemset/problem/500/A

solve :: Int -> [Int] -> Bool
solve t a | reachable == t = True
          | otherwise      = False
          where reachable = last $ takeWhile (<= t) $ zipWith (+) [1..] a

main :: IO ()
main = do
    [_, t] <- map read . words <$> getLine :: IO [Int]
    a <- map read . words <$> getLine :: IO [Int]
    putStrLn $ if solve t a then "YES" else "NO"

-- Vicfred
-- https://codeforces.com/problemset/problem/500/A

solve :: Int -> [Int] -> Bool
solve t a | reachable == t = True
          | otherwise      = False
          where reachable = last $ takeWhile (<= t) $ zipWith (+) [1..] a

main :: IO ()
main = do
    [_, t] <- map read . words <$> getLine :: IO [Int]
    a <- map read . words <$> getLine :: IO [Int]
    print $ if solve t a then "YES" else "NO"

main = do
    constraints <- getLine
    lineSystem <- getLine

    let [_, destination] = readInts constraints
        portals = zip (readInts lineSystem) [1..]

    putStrLn $ result portals destination

readInts :: String -> [Int]
readInts = map read . words

result :: [(Int, Int)] -> Int -> String
result [] _ = "NO"
result (x:xs) dest
  | index == dest = "YES"
  | index > dest  = "NO"
  | otherwise     = result (drop jump (x:xs)) dest
  where (jump, index) = x

import qualified Data.Map as Map
import Data.Maybe (fromJust)

process :: Int -> Int -> [Int] -> Bool
process n t xs = f t
    where
        m = Map.fromList $ zipWith (\i x -> (i+x,x)) [1..] xs
        f 1 = True
        f t
            | t' == Nothing = False
            | otherwise = f $ fromJust t'
            where t' = Map.lookup t m

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,t] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    putStrLn $ ["NO","YES"] !! fromEnum (process n t as)

import Data.Graph

process :: Int -> Int -> [Int] -> Bool
process n t xs = path g 1 t
    where g = buildG (1,n) $ zipWith (\i x -> (x,i+x)) [1..] xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,t] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    putStrLn $ ["NO","YES"] !! fromEnum (process n t as)

reach _ [] = "NO"
reach 0 _ = "YES"
reach t (a:ais)
  | t > 0 = reach (t - a) $ drop (a - 1) ais
  | otherwise = "NO"

solve str =
  let (n:t:ais) = (map read . words) str
  in reach (t - 1) ais

main = interact solve