import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = show answer
    where
        n::Int64
        as::[Int64]
        n:as = map fastRead (words input)
        arras = A.listArray (0,n-1) as

        with_div3_r = snd (foldr rdp_folder (0,[]) as)
        with_div3_l = (reverse.snd) (foldl ldp_folder (0,[]) as)
        with_div3_l_a = A.listArray (1,n) with_div3_l

        rsum_div3_r::[Int64]
        rsum_div3_r = take (fromIntegral n) (scanr (+) 0 with_div3_r)
        rsum_div3_r_a = A.listArray (1,n) rsum_div3_r

        rdp_folder nextnum (cum,cumxs)
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        ldp_folder:: (Int64,[Int64]) -> Int64 -> (Int64,[Int64])
        ldp_folder (cum,cumxs) nextnum
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        tsum = sum as
        div3 = truncate ((fromIntegral tsum :: Double)/3)

        answer = if tsum `mod` 3 == 0 then
                    foldl' answer_folder 0 [1..(n-2)]
                 else
                     0

        answer_folder cumul nextidx
            | with_div3_l_a!nextidx == 1 =
                cumul + rsum_div3_r_a!(nextidx+2)
            | otherwise = cumul

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0 :: Int64
    scan (l:ls) rs k = (fromIntegral k') + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}
import Data.List
import Numeric
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ show.solve. concat. map (map fastRead.words).take 2.lines
solve :: [Integer]-> Integer
solve (x:xs) = slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=fromIntegral $ length scn in (l-1)*(l-2) `div` 2
       |otherwise = head $ tail $ foldl (f) [0,0] scn
          where
          f [b1,b2] a = if a==head sm then [1+b1,b2] else [b1,b1+b2]
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b
fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

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

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

app = do
  n <- poi
  show `fmap` solve n `fmap` replicateM n p64
  where
  pop = state $ \(x:xs) -> (x, xs)
  p64 = fmap (to64 . int) pop
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve :: Int -> [Int64] -> Int64
solve n xs = case sum xs `quotRem` 3 of
  (s0, 0) -> sum $ zipWith (*) (take (n - 1) $ map (\s -> fromIntegral $ fromEnum (s == s0)) $ scanl1 (+) xs) (drop 2 $ scanr (\s p -> p + fromIntegral (fromEnum $ s == s0)) 0 $ scanr1 (+) xs)
  _ -> 0 :: Int64

import Data.Array.ST.Safe
import Data.Int
import Control.Monad.ST
import Control.Monad
import Data.STRef

main = do
  n <- readLn
  as <- map read . words <$> getLine
  print $ runST $ do
    acc <- newArray_ (0,n) :: ST s (STUArray s Int Int64)
    writeArray acc 0 0
    forM_ (zip [1..] as) $ \(i,a) ->
      writeArray acc i . (a +) =<< readArray acc (i-1)

    total <- readArray acc n

    ls <- newArray_ (0,n) :: ST s (STUArray s Int Int64)
    writeArray ls 0 0
    forM_ [1..n] $ \i -> do
      s <- readArray acc i
      writeArray ls i . (fromIntegral (fromEnum (3*s == total)) +)
        =<< readArray ls (i-1)

    c <- newSTRef 0
    forM_ [2..n-1] $ \i -> do
      s <- readArray acc i
      when (3*s == 2*total) $
        modifySTRef' c . (+) =<< readArray ls (i-1)
    readSTRef c

import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.g.parse.tail.words
parse = map fastRead
g xs
  | i `mod` 3 /= 0 = 0
  | otherwise = f (i `div` 3) 0 xs 0 0
  where i = sum xs

f i tsum (x:[]) a1 a2 = a2
f i tsum (x:xs) a1 a2
  | h == i && h == j = f i h xs (a1+1) (a2+a1)
  | h == i = f i h xs (a1+1) a2
  | h == j = f i h xs a1 (a2+a1)
  | otherwise = f i h xs a1 a2
  where h = tsum+x
        j = 2*i

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

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

app = do
  n <- poi
  show `fmap` solve n `fmap` replicateM n p64
  where
  pop = state $ \(x:xs) -> (x, xs)
  p64 = fmap (to64 . int) pop
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve n xs = case sum xs `quotRem` 3 of
  (s0, 0) -> sum $ zipWith (*) (take (n - 1) $ map (\s -> fromEnum (s == s0)) $ scanl1 (+) xs) (drop 2 $ scanr (\s p -> p + fromEnum (s == s0)) 0 $ scanr1 (+) xs)
  _ -> 0 :: Int

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h (x:y:[]) = (x+1)*(y+1)
h x = 0

f x
  | rem i 3 == 0 = if j == [] then (c (length x)) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h :: [Integer] -> Integer
h (x:y:[]) = (x+1)*(y+1)
h x = 0

f :: [Integer] -> Integer
f x
  | rem i 3 == 0 = if j == [] then (c (fromIntegral (length x))) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial :: Integer -> Integer
factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

main = interact $ show.f.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

h (x:y:[]) = (x+1)*(y+1)

f x
  | rem i 3 == 0 = if j == [] then ((length x) `c` 3) else (h j)
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x = reduce x []
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial n = product [1..n]
c n r = (factorial n) `div` ((factorial r)*(factorial (n-r)))

main = interact $ show.a.parse.tail.words
parse x = map read x :: [Integer]

g [] x y temp z = z
g (w:ws) x y temp z
  | x == y && w == 0 = g ws x y (temp+1) z
  | x == y && w /= 0 = g ws x w 0 (temp:z)
  | otherwise = g ws x (w+y) temp z

zeroes [] ans = ans
zeroes (x:xs) ans
  | x /= 0 = 0
  | otherwise = zeroes xs (ans+1)

h :: [Integer] -> Integer
h (x:y:[]) = (x+1)*(y+1)
h x = 0

f :: [Integer] -> Integer
f x
  | rem i 3 == 0 = h j
  | otherwise = 0
  where i = sum x
        j = g x (div i 3) 0 0 []

a x
  | k /= 0 = (c k)
  | otherwise = f (reduce x [])
  where k = (zeroes x 0)
reduce [] ans = ans
reduce (x:[]) ans = reduce [] (x:ans)
reduce (x:y:xs) ans
  | x == 0 = reduce (y:xs) (0:ans)
  | x == (-y) = reduce xs (0:ans)
  | otherwise = reduce (y:xs) (x:ans)

factorial :: Integer -> Integer
factorial n = product [1..n]
c n = (factorial (n-1)) `div` ((factorial (n-3))*2)

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

main = do
  getLine
  xs <- getInts

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0 :: Int64
    scan (l:ls) rs k = (fromIntegral k') + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

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

main = do
  getLine
  xs <- getInts

  let
    s = sum xs
    s3 = s`div`3

    ls = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanl1 (+) xs
    rs = map fst $ filter ((== s3) . snd) $ zip [1..] $ scanr1 (+) xs

    scan [] _ _ = 0
    scan (l:ls) rs k = k' + scan ls rs'' k'
      where
        (rs', rs'') = break (l+1 <) rs
        k' = k - length rs'

  print $
    if s`mod`3 == 0
       then scan ls rs $ length rs
       else 0

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x:xs) = show slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in l*(l-1)*(l-2) `div` 6
       |otherwise = length [1| i<- scn,j<-scn, k<-scn,i<j,j<k]
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
    where
    f [b] a = a== b || a== 2*b || a== 3*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ show.solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> Int64
solve (x:xs) = slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=fromIntegral $ length scn in (l-1)*(l-2) `div` 2
       |otherwise =snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Integer]-> String
solve (x:xs) = show $ slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in (l-1)*(l-2) `div` 2
       |otherwise = snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x:xs) = show $ slv1
  where
  slv1 |sm==[] || x<3 = 0
       |sm==[0]  = let l=length scn in (l-1)*(l-2) `div` 2
       |otherwise = snd $ foldl (\(b1,b2) a -> if a==head sm then (1+b1,b2) else (b1,b1+b2)) (0,0) scn
  sm= let s = sum xs in if s `mod` 3 /=0 then [] else [s `div` 3]
  scn =filter ( f sm) $ tail $ scanl (+) 0 xs
  f [b] a = a== b || a== 2*b

import Data.List

main = interact gen

replicate_num = 5000

gen input = intercalate " " (map show toout)
    where
        toout::[Int]
        toout = (replicate_num*2):numarrs
        numarrs::[Int]
        numarrs = (foldr (++) [] replicated)
        basic::[Int]
        basic = [1,(-1)]
        replicated::[[Int]]
        replicated = replicate replicate_num basic

import Data.List
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead s = d
    where
        (d,r) = head (readDec s)

main = interact solve

solve input = show answer
    where
        n:as = map read (words input)
        arras = A.listArray (0,n-1) as

        with_div3_r = snd (foldr rdp_folder (0,[]) as)
        with_div3_l = (reverse.snd) (foldl ldp_folder (0,[]) as)
        with_div3_l_a = A.listArray (1,n) with_div3_l

        rsum_div3_r::[Int]
        rsum_div3_r = take n (scanr (+) 0 with_div3_r)
        rsum_div3_r_a = A.listArray (1,n) rsum_div3_r

        rdp_folder nextnum (cum,cumxs)
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        ldp_folder:: (Int,[Int]) -> Int -> (Int,[Int])
        ldp_folder (cum,cumxs) nextnum
                | ncum == div3 = (ncum, 1:cumxs)
                | otherwise = (ncum, 0:cumxs)
                where ncum = cum+nextnum

        tsum = sum as
        div3 = truncate ((fromIntegral tsum :: Double)/3)

        answer = if tsum `mod` 3 == 0 then
                    foldl' answer_folder 0 [1..(n-2)]
                 else
                     0

        answer_folder cumul nextidx
            | with_div3_l_a!nextidx == 1 =
                cumul + rsum_div3_r_a!(nextidx+2)
            | otherwise = cumul

import Data.Array
import Data.List
import Data.Int
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n
  let ls = listArray (0,n-1) $ scanl (+) 0 $
           map (\l -> fromIntegral $ fromEnum (3*a!l == s) :: Int64) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (ls !) rs

import Data.Array
import Data.List
import Data.Int
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n :: Int64
  let ls = listArray (0,n-1) $ scanl (+) 0 $
           map (\l -> fromIntegral $ fromEnum $ 3*a!l == s :: Int64) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (ls !) rs

import Data.Array
import Data.List
main = do
  n <- readLn
  a <- listArray (1,n) . scanl1 (+) . map read . words <$> getLine
  let s = a!n
  let ls = listArray (0,n-1) $ scanl (+) 0 $ map (\l -> fromEnum (3*a!l == s)) [2..n]
  let rs = findIndices (\r -> 3*a!r == 2*s) [1..n-1]
  print $ sum $ map (\r -> ls!r) rs


import qualified Data.Array as A
import Data.Char
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost l = A.listArray (0, 2) [d isAlpha l, d isDigit l, d isRest l]
            where isRest c = (&&) (not (isAlpha c)) (not (isDigit c))
        d f = minimum. (inf :). map (dist. fst). filter (f. snd). zip [0..]
            where dist i = min i (m - i)
                  inf = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
        op i j k = getC i 0 + getC j 1 + getC k 2
            where getC a b = costs A.! a A.! b

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Char

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

klass c
  | isDigit c = 0
  | isAsciiLower c = 1
  | otherwise = 2

solve ms n m = minimum [tbl!(i, 0) + tbl!(j, 1) + tbl!(k, 2) | i:j:k:_ <- sequence $ replicate 3 [1..n], i /= j, j /= k, k /= i]
  where
    ms' = listArray (1, n) ms
    tbl = array ((1, 0), (n, 2)) [((i, k), go i k) | i <- [1..n], k <- [0..2]]
    go i k = let s = ms'!i in minimum $ 10000:[min j (m - j) | j <- [0..m - 1], klass (s `B.index` j) == k]

main = do
  n:m:_ <- readInts <$> B.getLine
  ms <- replicateM n B.getLine
  print $ solve ms n m

import qualified Data.Array as A
import Data.Char
import Data.List
import Control.Applicative

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost = A.listArray (0, 2). zipWith d [isAlpha, isDigit, isRest]. repeat
            where isRest c = not. or. map ($ c) $ [isAlpha, isDigit]
        d f = minimum. (inf :). map (dist. fst). filter (f. snd). zip [0..]
            where dist i = min i (m - i)
                  inf = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
            where op i j k = sum. zipWith getC [i,j,k] $ [0, 1, 2]
                  getC a b = costs A.! a A.! b
                  bad (a,b,c) = a == b || b == c || a == c

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE FlexibleContexts     #-}

import Data.Array.Unboxed
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.MArray.Safe
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Data.Bits
import Data.Maybe

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine
    css <- replicateM n getLine
    print $ solve n css

solve :: Int -> [String] -> Int
solve n css = fromJust $ minCostFlow (n+5) numE gr src sink 3
  where
    num = n
    alpha = n + 1
    symbol = n + 2
    src = n + 3
    sink = n + 4
    numE = 4 * n + 3
    gr = [(num, sink, 0, 1), (alpha,sink,0,1), (symbol,sink,0,1)]
      ++ [(src,i,0,1)|i<-[0..n-1]]
      ++ concat[[(i,num,x,1),(i,alpha,y,1),(i,symbol,z,1)]|(i,cs)<-zip[0..]css,let(x,y,z)=calc cs]

convert c
  | '0' <= c, c <= '9' = 0
  | 'a' <= c, c <= 'z' = 1
  | otherwise = 2

calc cs = go inf inf inf $ zip [0..] ns ++ zip [1..](reverse$tail ns)
  where
    ns = map convert cs
    go !x !y !z ((i,c):rest)
      | c == 0 = go (min i x) y z rest
      | c == 1 = go x (min i y) z rest
      | otherwise = go x y (min i z) rest
    go !x !y !z [] = (x, y, z)

type Vertex = Int
type Edge = Int
type Cost = Int
type Cap = Int

inf :: Cost
inf = 0x3f3f3f3f
{-# INLINE inf #-}

-- Just cost -> flow0流した時の最小費用がcost
-- Nothing   -> flow0 を流すことは出来ない
minCostFlow :: Int -> Int -> [(Vertex,Vertex,Cost,Cap)] -> Vertex -> Vertex -> Cap -> Maybe Cost
minCostFlow numv nume vvccs source sink flow0 = runST $ do
  gr        <- newArray  (0,numv-1) []     :: ST s (STArray  s Vertex [Edge])
  residual  <- newArray  (0,2*nume-1) 0    :: ST s (STUArray s Edge Cap)
  to        <- newArray_ (0,2*nume-1)      :: ST s (STUArray s Edge Vertex)
  cost      <- newArray_ (0,2*nume-1)      :: ST s (STUArray s Edge Cost)
  potential <- newArray  (0,numv-1) 0      :: ST s (STUArray s Vertex Cost)
  dist      <- newArray  (0,numv-1) inf    :: ST s (STUArray s Vertex Cost)
  prevv     <- newArray  (0,numv-1) (-1)   :: ST s (STUArray s Vertex Vertex)
  preve     <- newArray  (0,2*nume-1) (-1) :: ST s (STUArray s Vertex Edge)

  let mkGraph !i ((v,nv,c,cap):vvccs) = do
        modifyArray gr v (i:) >> modifyArray gr nv ((i+1):)
        writeArray to i nv    >> writeArray to (i+1) v
        writeArray cost i c   >> writeArray cost (i+1) (-c)
        writeArray residual i cap
        mkGraph (i+2) vvccs
      mkGraph _ _ = return ()

  let dijkstra (Fork v c hs) = do
        dv <- readArray dist v
        if c > dv then dijkstra $ mergePairs hs
        else do
          es <- readArray gr v
          hs' <- forM es $ \e -> do
            nv   <- readArray to e
            cap  <- readArray residual e
            hv   <- readArray potential v
            hnv  <- readArray potential nv
            v2nv <- readArray cost e
            old  <- readArray dist nv
            let dnv = dv + v2nv + hv - hnv
            if cap > 0 && dnv < old then do
              writeArray dist nv dnv
              writeArray prevv nv v
              writeArray preve nv e
              return $ Fork nv dnv []
            else return Empty
          dijkstra $ mergePairs hs `merge` mergePairs hs'
      dijkstra Empty = readArray dist sink

  let update flow = go sink flow
         where
           go !v !f = do
             pv <- readArray prevv v
             if pv < 0 then return f
             else do
               pv2v <- readArray preve v
               nf <- readArray residual pv2v >>= go pv . min f
               modifyArray residual pv2v (subtract nf)
               modifyArray residual (xor pv2v 1) (nf+)
               return nf

  let primalDual !flow !res
        | flow == 0 = return $ Just res
        | otherwise = do
            rep numv $ \i ->
                writeArray dist i inf
            writeArray dist source 0
            dsink <- dijkstra $ Fork source 0 []
            if dsink == inf then return Nothing
            else do
              rep numv $ \v-> do
                dv <- readArray dist v
                modifyArray potential v (dv+)
              f <- update flow
              hsink <- readArray potential sink
              primalDual (flow - f) $ hsink * f + res

  mkGraph 0 vvccs
  primalDual flow0 0

rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}

modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}

-- Pairing heap for Dijkstra
data Heap = Fork {-# UNPACK #-} !Vertex
                 {-# UNPACK #-} !Cost
                                [Heap]
          | Empty

merge :: Heap -> Heap -> Heap
merge hx@(Fork _ x _) hy@(Fork _ y _)
  | x <= y    = join hx hy
  | otherwise = join hy hx
 where
   join (Fork v cost hs) h = Fork v cost (h:hs)
merge Empty hy = hy
merge hx Empty = hx

mergePairs :: [Heap] -> Heap
mergePairs []       = Empty
mergePairs [x]      = x
mergePairs (x:y:hs) = merge (merge x y) (mergePairs hs)

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Char

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

klass c
  | isDigit c = 0
  | isAsciiLower c = 1
  | otherwise = 2

solve ms n m = minimum [tbl!(i, 0) + tbl!(j, 1) + tbl!(k, 2) | i:j:k:_ <- sequence $ replicate 3 [1..n], i /= j, j /= k]
  where
    ms' = listArray (1, n) ms
    tbl = array ((0, 0), (n, 2)) [((i, k), go i k) | i <- [0..n], k <- [0..2]]
    go 0 _ = 10000
    go i k = let s = ms'!i in minimum $ tbl!(i-1, k):[min j (m - j) | j <- [0..m - 1], klass (s `B.index` j) == k]

main = do
  n:m:_ <- readInts <$> B.getLine
  ms <- replicateM n B.getLine
  print $ solve ms n m

import qualified Data.Array as A
import Data.Char
import Data.List

main = interact $ printAns. (\(a,b,c) -> solve a b c). readInp

readInp = prep. lines
    where prep l = ((!! 0). getFst $ l, (!! 1). getFst $ l, tail l)
          getFst = fmap read. words. head
printAns = show

solve :: Int -> Int -> [String] -> Int
solve n m a = minimum ops
    where
        costs = A.listArray (0, n-1) (map cost a)
        cost l = A.listArray (0, 2) [d isAlpha l, d isDigit l, d isRest l]
        isRest c = (&&) (not (isAlpha c)) (not (isDigit c))
        d f = minimum. (alot :). map (dist. fst). filter (f. snd). zip [1..]
        dist i = min i (m - i)
        alot = 10^8 + 23

        ops = [op i j k | i <- [0..n-1], j <- [0..n-1], k <- [0..n-1], i /= j, i /= k, j /= k]
        op i j k = getC i 0 + getC j 1 + getC k 2
            where getC a b = costs A.! a A.! b


{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
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.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
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)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn
    l <- replicateM n getLine
    s <- getLine
    let s' = encodeMessage l
    putStrLn $ case match s' s of
        True -> "yes"
        False -> "no"

encodeMessage :: [String] -> String
encodeMessage l = concat $ ["<3"++w | w <- l] ++ ["<3"]

match ptn str = go ptn str
    where
    go [] _ = True
    go _ [] = False
    go (x:xs) (y:ys) | x == y = go xs ys
                     | otherwise = go (x:xs) ys

import Control.Monad (replicateM)
import Data.List (intersperse)

(?) :: Bool -> a -> a -> a
(?) p a b  =  if p then a else b

solve :: [String] -> String -> Bool
solve ss ms  =  solve' ss' ms
  where
    ss'  =  concat [word, concat $ intersperse word ss, word]
    word  =  "<3"
    solve' "" _  =  True
    solve' _ ""  =  False
    solve' (s:ss) (m:ms)
      | s == m  =  solve' ss ms
      | otherwise  =  solve' (s:ss) ms

main :: IO ()
main  =  do
    n   <-  readLn
    ss  <-  replicateM n getLine
    ms  <-  getLine
    putStrLn $ (solve ss ms) ? "yes" $ "no"

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = "<3" ++ intercalate "<3" ws ++ "<3"
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  -- putStrLn expectedSs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"

import Control.Monad
import Control.Applicative

search :: String -> String -> Bool
search [] _ = True
search (x:xs) [] = False
search s1@(x:xs) (y:ys)
  | x == y = search xs ys
  | otherwise = search s1 ys

main :: IO ()
main = do
  n <- (read <$> getLine) :: IO Int
  wlist <- replicateM n $
    getLine

  let str = (concatMap ("<3"++) wlist ++ "<3")
  bigstr <- getLine

  if search str bigstr
    then putStrLn "yes"
    else putStrLn "no"

import Control.Monad (replicateM)

main = do
    n <- fmap read getLine
    messageWords <- replicateM n getLine
    message <- getLine
    putStrLn $ if solve messageWords message then "yes" else "no"

intersperse' :: a -> [a] -> [a]
intersperse' y = foldr (\x acc -> y:x:acc) [y]

solve :: [String] -> String -> Bool
solve messageWords = matches (intersperse' "<3" messageWords)

matches :: [String] -> String -> Bool
matches [] _ = True
matches (w:ws) text = case w `subSeqOf` text of
    Nothing -> False
    Just text' -> matches ws text'

subSeqOf :: String -> String -> Maybe String
subSeqOf "" txt = Just txt
subSeqOf _ "" = Nothing
subSeqOf (c:cs) (t:txt)
    | c == t = subSeqOf cs txt
    | otherwise = subSeqOf (c:cs) txt

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM)
import Data.Functor ((<$>))
import qualified Data.ByteString as B

main = do
    n <- fmap read getLine
    messageWords <- B.concat . intersperse' "<3" <$> replicateM n (fmap B.init B.getLine)
    message <- B.getLine
    putStrLn $ if solve messageWords message then "yes" else "no"

{-# INLINE intersperse' #-}
intersperse' :: a -> [a] -> [a]
intersperse' y = foldr (\x acc -> y:x:acc) [y]

solve :: B.ByteString -> B.ByteString -> Bool
solve "" txt = True
solve _ "" = False
solve words text
    | B.head words == B.head text = solve (B.tail words) (B.tail text)
    | otherwise = solve words (B.tail text)

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = "<3" ++ intercalate "<3" ws ++ "<3"
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  putStrLn expectedSs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"

module Main where
import Control.Applicative
-- import Control.Monad
import Data.List
main :: IO ()
main = do
  _ <- read <$> getLine :: IO Int
  res <- lines <$> getContents :: IO [String]
  let msg:ws = let x:xs = reverse res
                  in x:reverse xs
      expectedSs = intercalate "<3" ws
      stripChars [] _ = []
      stripChars (ch:chs) ch'
        | ch == ch' = chs
        | otherwise = ch:chs
  putStr $
    case foldl stripChars expectedSs msg of
      "" -> "yes"
      _ -> "no"


import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.State
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.STRef

operate :: [[Integer]] -> Integer
operate l = runST $ do
    cnt <- newSTRef (head (head l))
    summ <- newSTRef (0::Integer)
    mapM_ (\(x:y:xs) -> do
                cur <- readSTRef cnt
                if cur <= x then modifySTRef summ (+y) >>
                                 writeSTRef cnt (x+1)
                else return ()
                ) l
    readSTRef summ

comp :: [Integer] -> [Integer] -> Ordering
comp (a:[]) _ = LT
comp _ (a:[]) = GT
comp (a:b:[]) (c:d:[]) = if (a < c) then LT
                         else if (a > c) then GT
                              else if (b < d) then GT
                                   else if (b > d) then LT
                                        else EQ

main :: IO ()
main = do
    cn <- B.getContents
    let parsed = map ((map (\l -> let res = B.readInteger l in
                                    case res of
                                        Just a    -> fst a
                                        otherwise -> 0::Integer)) . B.words
                     ) (B.lines cn)
    let res = sortBy comp parsed

    let ans = operate (tail (tail res))
    print ans
    return ()

module Main where

import qualified Data.IntMap.Strict as M
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString as BS

getElements :: IO ((M.IntMap Int,M.IntMap Int))
getElements = do
  input <- fmap (C.split '\n') $ BS.getContents
  let count1 = read . C.unpack . head $ input
      list1 = [(v1, v2) | edgeBS <- take count1 . tail $ input,
               let [v1', v2'] = C.split ' ' edgeBS
                   Just (v1,_) = C.readInt v1'
                   Just (v2,_) = C.readInt v2']
      list2 = [(v1, v2) | edgeBS <- drop (count1 + 2) input, not $ BS.null edgeBS,
               let [v1', v2'] = C.split ' ' edgeBS
                   Just (v1,_) = C.readInt v1'
                   Just (v2,_) = C.readInt v2']
  return (M.fromList list1, M.fromList list2)

main = do
  (top, forces) <- getElements
  let income = M.foldl (\acc income ->
                          acc + toInteger income) (0 :: Integer) $ M.unionWith max forces top
  print income

module Main where

import qualified Data.IntMap.Strict as M

getElements :: IO (M.IntMap Int)
getElements = do
  count <- fmap read getLine
  list <- sequence $ take count $ repeat $ do
    [id, income] <- fmap (map read . words) getLine
    return (id, income)
  return $ M.fromList list

main = do
  forces <- getElements
  top <- getElements
  let intersection = M.intersectionWith max forces top
      difference1 = M.difference forces top
      difference2 = M.difference top forces
      income = M.foldl (+) 0 $ M.unions [intersection, difference1, difference2]
  print income

module Main where

import qualified Data.IntMap.Strict as M

getElements :: IO (M.IntMap Int)
getElements = do
  count <- fmap read getLine
  list <- sequence $ take count $ repeat $ do
    [id, income] <- fmap (map read . words) getLine
    return (id, income)
  return $ M.fromList list

main = do
  forces <- getElements
  top <- getElements
  let income = M.foldl (+) 0 $ M.unionWith max forces top
  print income

import Control.Monad
import Control.Monad.Trans.State
import qualified Data.Foldable as F
import Data.List
import qualified Data.Map as M

type MII = M.Map Int Int

operate :: [[Int]] -> State MII Int
operate inp = do
    forM_ inp (\(x:y:xs) -> do
                    m <- get
                    let a = M.lookup x m
                    case a of
                        Nothing -> put (M.insert x y m)
                        Just pr -> if (pr < y) then put (M.insert x y m)
                                               else return ()
              )
    m <- get
    return $ F.foldl (+) 0 m

main :: IO ()
main = do
    n <- getLine
    let nn = read n :: Int
    inpn <- replicateM nn getLine
    let inppn = map ((map read) . words) inpn
    let inpppn = map (\(x:y:xs) -> (x, y)) inppn
    let mp = M.fromList inpppn
    m <- getLine
    let mm = read m :: Int
    inpm <- replicateM mm getLine
    let inpmm = map ((map read) . words) inpm
    print $ evalState (operate inpmm) mp
    return ()


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

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

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

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main :: IO ()
main = do
    (n,m) <- readIntPair
    l <- replicateM m $ do
        [t,l,r,d] <- readInts
        return (t,l,r,d)
    case solve n l of
        Nothing -> putStrLn "NO"
        Just xs -> do
            putStrLn "YES"
            putStrLn $ unwords $ map show $ xs

type Op = (Int,Int,Int,Int)
solve :: Int -> [(Int,Int,Int,Int)] -> Maybe [Int]
solve n l = guard (check n l xs) >> return xs
    where
    xs = elems ans
    ans :: UArray Int Int
    ans = runSTUArray $ do
        a <- newArray (1,n) inf  :: ST s (STUArray s Int Int)
        b <- newArray (1,n) 0    :: ST s (STUArray s Int Int)
        forM_ l $ \l -> case l of
            (1,l,r,d) ->
                forM_ [l..r] $ \i -> do
                    x <- readArray b i
                    writeArray b i (x+d)
            (2,l,r,d) ->
                forM_ [l..r] $ \i -> do
                    x <- readArray a i
                    y <- readArray b i
                    writeArray a i (min x (d - y))
        return a

inf :: Int
inf = 10^9
check :: Int -> [(Int,Int,Int,Int)] -> [Int] -> Bool
check n l xs = maximum (map abs xs) <= inf && (isJust $ foldM f init l)
    where
        init :: UArray Int Int
        init = listArray (1,n) xs
        f a (1,l,r,d) = return $ accum (+) a[(i,d) | i <- [l..r]]
        f a (2,l,r,d) = do
            guard $ d == maximum [ a ! i | i <- [l..r]]
            return a

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

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

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

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main :: IO ()
main = do
    (n,m) <- readIntPair
    l <- replicateM m $ do
        [t,l,r,d] <- readInts
        return (t,l,r,d)
    case solve n l of
        Nothing -> putStrLn "NO"
        Just xs -> do
            putStrLn "YES"
            putStrLn $ unwords $ map show $ xs

type Op = (Int,Int,Int,Int)
solve :: Int -> [(Int,Int,Int,Int)] -> Maybe [Int]
solve n l = guard (check n l xs) >> return xs
    where
    xs = elems ans
    ans :: UArray Int Int
    ans = go (listArray (1,n) (repeat inf)) (listArray (1,n) (repeat 0)) l
    go :: UArray Int Int -> UArray Int Int -> [Op] -> UArray Int Int
    go a _ [] = a
    go !a !b ((1,l,r,d):ls) = go a (accum (+) b [(i,d) | i <- [l..r]]) ls
    go !a !b ((2,l,r,d):ls) = go (accum min a [(i,d - b ! i) | i <- [l..r]])b ls

inf :: Int
inf = 10^9
check :: Int -> [(Int,Int,Int,Int)] -> [Int] -> Bool
check n l xs = maximum (map abs xs) <= inf && (isJust $ foldM f init l)
    where
        init :: UArray Int Int
        init = listArray (1,n) xs
        f a (1,l,r,d) = return $ accum (+) a[(i,d) | i <- [l..r]]
        f a (2,l,r,d) = do
            guard $ d == maximum [ a ! i | i <- [l..r]]
            return a

{-# LANGUAGE BangPatterns,TupleSections #-}
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Maybe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readIntPair :: IO (Int,Int)
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)

type Op = (Int,Int,Int,Int)
inf :: Int
inf = 10^(9::Int)

main :: IO ()
main = do
    (n,m) <- readIntPair
    l <- replicateM m $ do
        [t,l,r,d] <- readInts
        return (t,l,r,d)
    case solve n l of
        Nothing -> putStrLn "NO"
        Just xs -> do
            putStrLn "YES"
            putStrLn $ unwords $ map show $ xs

solve :: Int -> [Op] -> Maybe [Int]
solve n ops = guard (check n ops xs) >> return xs
    where
    xs = elems $ go (g inf) (g 0) ops
    g k = listArray (1,n) (repeat k)
    go :: UArray Int Int -> UArray Int Int -> [Op] -> UArray Int Int
    go a _ [] = a
    go !a !b ((1,l,r,d):ls) = go a (accum (+) b [(i,d) | i <- [l..r]]) ls
    go !a !b ((2,l,r,d):ls) = go (accum min a [(i,d - b ! i) | i <- [l..r]])b ls

check :: Int -> [Op] -> [Int] -> Bool
check n ops xs = maximum (map abs xs) <= inf && (isJust $ foldM f e ops)
    where
    e = listArray (1,n) xs :: UArray Int Int
    f a (1,l,r,d) = return $ accum (+) a [(i,d) | i <- [l..r]]
    f a (2,l,r,d) = guard (d == maximum [ a ! i | i <- [l..r]]) >> return a


import Control.Monad (replicateM)

main = do t <- read <$> getLine
          replicateM t solve

mini :: Int -> Int -> Int
mini a b
  | a > b = b
  | otherwise = a

maxi :: Int -> Int -> Int
maxi a b
  | a > b = a
  | otherwise = b

solve = do xs <- (map read . words) <$> getLine
           if ((mini (xs !! 0) (xs !! 1)) > (maxi (xs !! 2) (xs !! 3))) || ((maxi (xs !! 0) (xs !! 1)) < (mini (xs !! 2) (xs !! 3)))
             then putStrLn "NO"
             else putStrLn "YES"

import qualified Data.ByteString as Bs
import Control.Monad

less a b = if a < b then a else b

more a b = if a > b then a else b

fair :: Int -> Int -> Int -> Int -> String
fair a b c d = if less c d > (more a b) || (less a b) > (more c d)
               then "NO"
               else "YES"

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

solve :: IO()
solve = do
  -- n <- readLn :: IO Int
  a <- readintrows 1
  putStrLn $ fair (head (head a)) (head a !! 1) (head a !! 2) (head a !! 3)

readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

import Data.Bool ( bool )

isFair :: [Int] -> Bool
isFair [a, b, c, d]
    | max a b < min c d = False
    | max c d < min a b = False
    | otherwise         = True

main = interact $ unlines . map solve . tail . lines
    where solve = bool "NO" "YES" . isFair . map read . words

import Data.List (sort)

pairToList (a, b) = [a, b]

solve :: [Int] -> String
solve l =
  if drop 2 (sort l) ==
     sort (map maximum $ pairToList $ splitAt 2 l) then
    "Yes"
  else
    "No"

main = interact $ unlines . map (solve . map read . words) . tail . lines

import Data.List (sort)

pairToList (a, b) = [a, b]

solve :: [Int] -> String
solve l =
  if sort (drop 2 $ sort l) ==
    sort (map maximum $ pairToList $splitAt 2 l) then
    "Yes"
  else
    "No"

main = interact $ unlines . map (solve . map read . words) . tail . lines

import Control.Monad
import Data.Bool
import Data.List

solve :: IO ()
solve = do
    a <- readMany :: IO [Int]
    let [p, q] = drop 2 $ map snd $ sort $ zip a [0..]
        chk p q = p < 2 && q >= 2
    putStrLn $ bool "NO" "YES" $ chk p q || chk q p

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

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

import Control.Monad
import Data.List

calc :: [Int] -> String
calc l@[a,b,c,d] =
  let s = take 2 $ reverse $ sort l
      final = reverse $ sort [max a b, max c d]
  in
    if s == final then
      "YES"
    else
      "NO"

calc _ = "NO"

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

import Data.List
import Control.Arrow

solve x =
    let y = (uncurry (==)) . ((`div`2)***(`div`2)) . (\[x,y] -> (x,y)) .  drop 2 . map fst . sortOn snd .  zip [0..] $ x
    in if y  then "NO" else "YES"

main = interact $ unlines . map (solve  . map (read :: String -> Int) . words ) . tail  . lines

import Control.Arrow ((>>>))
import Data.List(sort)
import Data.Bool(bool)

main :: IO ()
main = interact $ lines >>> drop 1
         >>> map (words >>> map read >>> solve >>> bool "NO" "YES")
         >>> unlines

solve :: [Int] -> Bool
solve ss@[s1, s2, s3, s4] = max s1 s2 + max s3 s4 == (sum . drop 2 . sort $ ss)

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

printResult = do
    [a,b,c,d] <- readInts
    putStrLn $ if max a b > min c d && max c d > min a b then "YES" else "NO"

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

import Control.Monad
import Data.List
import System.IO
import Data.Char
import Data.Array
import Data.List
readInts = fmap (map read.words) getLine :: IO [Int]
solve = do
    [x,y,z,t] <- readInts
    let max1 = minimum [(maximum [x,y]), (maximum [z,t])]
        max2 = maximum [(maximum [x,y]), (maximum [z,t])]
    let a = reverse $ sort [x,y,z,t]
    putStrLn $ if max2 == head a && max1 == (head $ tail a) then "YES" else "NO"
main = do
    t <- readLn::IO Int
    replicateM_ t solve

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Int
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

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

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

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [s1, s2, s3, s4] <- map parseInt . BS.words <$> BS.getLine
        let r = min s1 s2 > max s3 s4 || min s3 s4 > max s1 s2
        putStrLn $ bool "YES" "NO" r

--1535/problem/A. Fair Playoff

import Data.List

toInt :: (String -> Int)
toInt x = read x ::Int

getInts = do
    x <- getLine
    let y = (map$toInt)$words x
    return y

loop i f
    |i==1 = f
    |otherwise = do
        f
        loop (i-1) f

isFair_co :: [Int]->String
isFair_co lst  = do
    if (reverse$sort$take 2 lst)==(take 2 (reverse$sort lst)) then
        "NO"
    else if (sort$drop 2 lst)==(drop 2 (sort lst)) then
        "NO"
    else
        "YES"
isFair = do
    lst <- getInts
    putStrLn$isFair_co lst

main = do
    n' <- getLine
    let n = toInt n'

    loop n isFair

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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	[ a, b, c, d ] <- readInts
	putStrLn $ if drop 2 ( sort [ a, b, c, d ] ) == sort [ max a b, max c d ]
		then "YES"
		else "NO"

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    as@[a1, a2, a3, a4] <- getInts
    let result = sort [max a1 a2, max a3 a4] == drop 2 (sort as)
    return $ string7 (if result then "YES" else "NO") `mappend` charUtf8 '\n'
  hPutBuilder stdout output


{-# 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
  n <- readInt <$> getLine
  as <- unfoldr (runStateT rIntS) <$> BS.getLine
  print $ length $ filter id $ zipWith (==) [1..] $ scanl1 max as

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

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

f x m a i = if null x then a else if i == (max m $ head x) then f (tail x) (head x) (a+1) (i+1) else f (tail x) (max m $ head x) a (i+1)
int = fst .fromJust  .B.readInt
ints = map int . B.words <$> B.getLine
_' = B.getLine

main = _' >> ints >>= \x -> print $ f x 0 0 1

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

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

solve :: [Int] -> Int
solve xs = fst . foldl (\(a, b) (c, i) ->
                    if (max c b) > i
                    then (a, max c b)
                    else (a + 1, i)) (0, 0) $ zip xs [1..]

main :: IO ()
main = do
    _ <- readInt
    xs <- readInts
    print $ solve xs

--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
import Data.List

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

solve :: [Int] -> Builder
solve (!n:a) = intDec res <> char7 '\n'
  where
    b = take n a
    res = length $ filter id $ zipWith (==) [(1::Int) ..] $ scanl1 max b

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


--first time I'm actually using Haskell for a contest (or anything of significance), so ...
--let's hope we don't get problems that require mutable state (or I'll be spending rest of contest reading about State monad)

--{-# LANGUAGE ScopedTypeVariables #-} --used for annotating monadic values
import Data.List
import Control.Monad
--import Control.Monad.State.Strict

--TODO: make better boilerplate code for I/O, parsing etc
parseLine = fmap (map read . words)
--toSpaced = intercalate " " . map show
--printSpaced = putStrLn . toSpaced

last_n n = reverse . take n . reverse

f s t 0 = s
f s t k =
    let
        l = length t
        allowed = filter (\index -> (last_n (l - index) s) == (take (l - index) t)) [1..length t]
        min_allowed = head allowed
    in f (s ++ last_n min_allowed t) t (k - 1)

main :: IO ()
main = do
    [n, k] <- parseLine getLine :: IO [Int]
    t <- getLine :: IO String
    let ans = f t t (k - 1)
    putStrLn ans

    return ()

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

main = sol <$> get <*> getLine >>= putStrLn

--get :: IO [Int]
get = fmap read . words <$> getLine

sol [n,k] t = fromJust . find (isPrefixOf t) . fmap (f k t) . tail . inits $ t

f k t = ((++) . join . replicate k) <*> (flip drop t . length)

sol' [n,k] t = show n ++ show k ++ t

overlap s = let n = length s in head [x | x <- [1..n], drop x s == take (n - x) s]

main = do
    [n, k] <- (map read . words) `fmap` getLine
    t <- getLine
    let o = overlap t
    putStrLn (concat (replicate k (take o t)) ++ drop o t)


import Control.Monad ( replicateM )
import Data.List (foldl')

main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    resp <- replicateM t $ do
        solve <$> getLine
    putStrLn . unlines $ [if ans then "YES" else "NO" | ans <- resp]

solve :: [Char] -> Bool
solve xs = foldl' (\ct x -> if x == 'N' then ct+1 else ct) 0 xs /= 1

import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe

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

main :: IO ()
main = do
    [t] <- readInts
    replicateM_ t $ do
        ar<-getLine
        let x = length $ filter (=='N') ar
        putStrLn $ if (x==1) then "NO" else "YES"

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.interact $ B.unlines . map solve . tail . B.words

solve :: B.ByteString -> B.ByteString
solve bstr = if (==1) . B.length . B.filter (=='N') $ bstr then B.pack "NO"
    else B.pack "YES"

import Control.Monad (replicateM)
validSeq :: [Bool] -> Bool
validSeq = not . (==1) . count not 0
  where count f acc [] = acc
        count f acc (x:xs) = count f (acc + if f x then 1 else 0) xs
main :: IO()
main = read <$> getLine >>=
       flip replicateM getLine >>=
       mapM_ (putStrLn . f)
  where f :: String -> String
        f = (\b -> if b then "YES" else "NO") . validSeq . map (=='E')

import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe

{-
  _____   _____
  \    \  \    \
   \    \  \    \
    \    \  \    \
     \    \  \    \  \-----------|
      \    \  \    \  \   empr   |
       \    \  \    \  \---------|
       /    /  /     \
      /    /  /       \  \-------|
     /    /  /    ^    \  \      |
    /    /  /    / \    \  \ ----|
   /    /  /    /   \    \
  /____/  /____/     \____\

-}

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

readIntegers :: IO [Integer]
readIntegers = map (fst . fromJust . C.readInteger) . C.words <$> C.getLine

main :: IO ()
main = do
    [t] <- readInts
    replicateM_ t $ do
        ar<-getLine
        let x = length $ filter (=='N') ar
        putStrLn $ if (x/=1) then "YES" else "NO"

import Control.Monad (replicateM)
validSeq :: [Bool] -> Bool
validSeq = not . inValid

inValid :: [Bool] -> Bool
inValid (True:xs) = all_but_last_true xs
  where all_but_last_true [x] = not x
        all_but_last_true (True:y:xs) = all_but_last_true (y:xs)
        all_but_last_true (False:_:_) = False
inValid (False:xs) = all id xs
main :: IO()
main = read <$> getLine >>=
       flip replicateM getLine >>=
       mapM_ (putStrLn . f)
  where f :: String -> String
        f = (\b -> if b then "YES" else "NO") . validSeq . map (=='E')

import Control.Monad (replicateM)
validSeq :: [Bool] -> Bool
validSeq (x:y:[]) = (x ==> y)
  where (==>) True False = False
        (==>) _ _ = True
validSeq (x:y:xs) = validSeq ((x && y):xs)
main :: IO()
main = read <$> getLine >>=
       flip replicateM getLine >>=
       mapM_ (putStrLn . f)
  where f :: String -> String
        f = (\b -> if b then "YES" else "NO") . validSeq . map (=='E')


{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Function
import Data.Map (toList, fromListWith, adjust)

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> Int
solve xs | Data.List.null $ tail $ group xs = 0
         | otherwise = (+) 1 $ snd $ minimumBy (compare `on` snd) $ toList $ adjust (subtract 1) (last xs) $ adjust (subtract 1) (head xs) $ fromListWith (+) [(x, 1) | x <- fmap head $ group xs]

{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Data.Maybe
import Text.Printf
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_, foldM)
import qualified Data.Array.ST.Safe as SA
import Control.Monad.ST (ST, runST)
import Control.Monad (when)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

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

solve :: Int -> [Int] -> Int
solve n as = runST $ do
    let maybeAs = fmap Just as
    let pairs = zip maybeAs $ tail maybeAs
    costs <- SA.newArray (1, n) 1 :: ST s (SA.STArray s Int Int)
    modifyArray costs (head as) (\e -> e - 1)
    forM_ pairs $ \(currentA, nextA) -> do
        when (currentA /= nextA) $ modifyArray costs (fromJust currentA) (+1)
    foldM (\mn ix -> do
            e <- SA.readArray costs ix
            return $ min mn e
        ) n as

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntB8
    as <- B8.getLine <&> B8.words <&> map (readIntB8 >>> fromJust)
    let answer = solve n as
    printf "%d\n" answer

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Function

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> Int
solve xs
  | null $ tail $ group xs = 0
  | otherwise = length $ head $ sortBy (compare `on` length) $ fmap (foo last) $ fmap (foo head) $ fmap (\ys->(head ys):ys) $ group $ sort $ fmap head $ group xs  where
  foo bar ys = if head ys == bar xs then tail ys else ys

import Control.Arrow ((>>>))
import Data.List (group, sort)

main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs
  | length xs' == 1 = 0
  | length xs' == 2 = 1
  | head xs' `notElem` vs = 1
  | last xs' `notElem` vs = 1
  | otherwise = (1 +) . minimum . map length . group . sort $ vs
  where
    xs' = map head . group $ xs
    vs = init . tail $ xs'

import Data.List

solve :: [Int] -> Int
solve a = head . sort $ map (\(c,x) -> c + 1 - fromEnum(x==f) - fromEnum(x==l)) cnt
  where
    b = map head $ group a
    cnt = map (\a -> (length a, head a)) $ group $ sort b
    f = head b
    l = last b

main :: IO ()
main = interact $ unlines . map show . f . tail . map (map read) . map words . lines
  where f(_:x:xs) = solve x : f(xs)
        f[] = []

import Data.List

solve :: [Int] -> Int
solve a = head . sort $ map (\(c,x) -> c + 1 - fromEnum(x==f) - fromEnum(x==l)) cnt
  where
    b = map head $ group a
    cnt = map (\a -> (length a, head a)) $ group $ sort b
    f = head b
    l = last b

main :: IO ()
main = interact $ unlines . map show . f . map (map read . words) . tail . lines
  where f(_:x:xs) = solve x : f(xs)
        f[] = []

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Function

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> Int
solve xs
  | null $ tail $ group xs = 0
  | otherwise = (+) 1 $ length $ head $ sortBy (compare `on` length) $ fmap (foo last) $ fmap (foo head) $ group $ sort $ fmap head $ group xs  where
  foo bar ys = if head ys == bar xs then (head ys:ys) else ys

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Function
import Data.Map (toList, fromListWith, adjust)

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> Int
solve xs | Data.List.null $ tail $ group xs = 0
         | otherwise = (+) 1 $ snd $ minimumBy (compare `on` snd) $ toList $ adjust (subtract 1) (last xs) $ adjust (subtract 1) (head xs) $ fromListWith (+) [(x, 1) | x <- xs]


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

main = do
	n <- fst . fromJust . C.readInt <$> B.getLine
	[as, bs] <- replicateM 2 $ map (fst . fromJust . C.readInt) . B.split 32 <$> B.getLine
	putStrLn $ unwords $ map show $ elems $ array (1, n) (zip as bs)

import Control.Monad
import Data.List
import Data.Array.IO
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
main = do
  n <- (liftM $ fst . fromJust . C.readInt) B.getLine
  p1 <- (liftM $ (map $ fst . fromJust . C.readInt) . B.split 32) B.getLine
  p2 <- (liftM $ B.split 32) B.getLine
  arr <- newArray_ (1, n) :: IO (IOArray Int ByteString)
  forM_ (zip p1 p2) $ \(i, j) -> writeArray arr i j
  getElems arr >>= C.putStrLn . B.intercalate (B.singleton 32)


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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

solve xs = head xs

main = interact $ unlines . map (last . words) . chunk . drop 1 . lines

chunk []           = []
chunk (x: xs: [])  = xs: chunk []
chunk (x: xs: xss) = xs: chunk xss

import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  pure $ putInts [head a]

import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let
    xorall = foldl' xor 0 a
    ra = map (\x -> xor x xorall) a
    (pre, suf) = span (\(x, y) -> (/=) x y) $ zip a ra

  pure $ putInts [(snd . head) suf]

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int
solve n as = head as

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

(>>>) = flip (.)

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 2 >>> map (last >>> words >>> head) >>> unlines

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


import Control.Monad
import Data.Maybe
import Data.Int
import Data.List
import qualified Data.Array as A
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

getWords :: IO [Int64]
getWords = map (fromIntegral . parseInt) . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    ranges <- A.listArray (1, n) <$> replicateM n getWords
    let dupEdge [u, v] = [(u, v), (v, u)]
    adjs <- A.accumArray (flip (:)) [] (1, n) . concatMap dupEdge <$> replicateM (n - 1) getInts
    let dfs fa u = foldl' acc (u, 0, 0) childs
          where childs = map (dfs u) $ filter (/= fa) $ adjs A.! u
                [l, r] = ranges A.! u
                acc (_, tl, tr) (v, dl, dr) = (u, tl + f l, tr + f r)
                  where [lv, rv] = ranges A.! v
                        f x = max (abs (lv - x) + dl) (abs (rv - x) + dr)
        (_, a, b) = dfs 1 1
    return $ int64Dec (max a b) `mappend` charUtf8 '\n'
  hPutBuilder stdout output

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Maybe
import Data.Graph
import Data.Array
import Data.Int
import Control.Monad
import qualified Data.ByteString.Char8 as C

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

main = do
    [t] <- readInts
    replicateM_ t $ do
        [n] <- readInts
        bnds <- forM [1..n] $ \i -> do
            [l,r] <- fmap (map fromIntegral) readInts
            return (i, (l,r))
        edges <- fmap concat $ replicateM (n-1) $ do
            [u,v] <- readInts
            return [(u,v), (v,u)]
        let bnd = array (1,n) bnds
            graph = buildG (1,n) edges
            [tree] = dfs graph [1]
            (ansl,ansr) = calc bnd tree
        print $ max ansl ansr

calc :: Array Int (Int64,Int64) -> Tree Vertex -> (Int64,Int64)
calc bnd (Node u adjs) =
    foldl' foo (0,0) adjs where -- cause codeforces sucks'
        (ul,ur) = bnd!u
        foo (dpul,dpur) vn@(Node v _) =
            let (vl,vr) = bnd!v
                (dpvl,dpvr) = calc bnd vn
                dpulNew = max (abs (ul-vl) + dpvl) (abs (ul-vr) + dpvr)
                dpurNew = max (abs (ur-vl) + dpvl) (abs (ur-vr) + dpvr)
            in (dpul+dpulNew, dpur+dpurNew)

{-# OPTIONS_GHC -XStrict -XStrictData #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

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

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

solve :: Graph -> Array Int (Int64, Int64) -> Int64
solve g ab = let (r0,r1) = dfs 1 (-1) in max r0 r1
 where
    dfs x p =
        let
            a = fst $ ab ! x
            b = snd $ ab ! x
            pingo = [(dfs y x, ab ! y) | y <- g ! x, y /= p]
            doit v = sum $ map (\((r0,r1),(y0,y1)) -> max (r0 + abs (y0-v)) (r1 + abs (y1-v))) pingo
        in
            (doit a, doit b)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        rs <- replicateM n $ do
            [l, r] <- map (fromIntegral . parseInt) . BS.words <$> BS.getLine
            return (l,r)
        es <- replicateM (n-1) $ do
            [a, b] <- map parseInt . BS.words <$> BS.getLine
            return (a,b)
        let g = buildG (1,n) (es ++ map swap es)
        print $ solve g (listArray (1,n) rs)


import Array ((!), accumArray)
import Char (isDigit, ord)
import Control.Monad (liftM)
import Data.List (foldl')
import Maybe (fromMaybe)

--import CPUTime
--import IO (hPutStrLn, stderr)

--------------------------------------------------------------------------------
{-
import HUnit

testSimple :: Test
testSimple  =  TestList "TestSimple" $
  [
    Test "1" $ assertEq (Just 9) $
        solve 3 9 [(i, j) | i <- [1..3], j <- [1..3]],
    Test "2" $ assertEq Nothing $
        solve 3 1 [(1,1)],
    Test "3" $ assertEq Nothing $
        solve 3 8 [(i,j) | i <- [1..3], j <- [1..3], i /= 2 || j /= 2]
  ]

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq (Just 10) $ solve 4 11
      [(1,1), (1,2), (1,3), (2,2), (2,3), (1,4), (2,4), (3,4), (3,2), (3,3), (4,1)],
    Test "2" $ assertEq Nothing $ solve 4 12
      [(1,1), (1,2), (1,3), (2,2), (2,3), (1,4), (2,4), (3,4), (3,2), (4,2), (4,1), (3,1)]
  ]

testSmallField :: Test
testSmallField  =  Test "TestSmallField" $
  assertEq Nothing $ solve 2 4 [(2,1),(1,2),(2,2),(1,1)]

testBadLogic :: Test
testBadLogic  =  Test "TestBadLogic" $
  assertEq (Just 9) $ solve 16 9 [(2 + di, 1 + dj) | di <- [0..2], dj <- [0..2]]

testError9 :: Test
testError9  =  Test "TestError9" $
    assertEq (Just 11) $ solve 500 16 [(i,j) | i <- [1..4], j <- [1..4]]

testBigField :: Test
testBigField  =  Test "TestBigField" $
  assertEq Nothing $ solve 500 1 [(500,500)]

testManyPoints :: Test
testManyPoints  =  Test "TestManyPoints" $
  assertEq (Just n) $ solve 3 n $
    take n $ cycle [(i, j) | i <- [1..3], j <- [1..3]]
  where
    n  =  10^5

testBig :: Test
testBig  =  Test "TestBig" $
  assertEq (Just 1003) $ solve 500 n $
    take n [(i, j) | i <- [1..500], j <- [1..500]]
  where
    n  =  10^5

test :: IO ()
test  =  mapM_ run
  [
    testSimple,
    testInput,
    testSmallField,
    testBadLogic,
    testError9,
    testBigField,
    testManyPoints,
    testBig
  ]
-}
--------------------------------------------------------------------------------

solve :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve n m points
  | ans == (m+1)  =  Nothing
  | otherwise  =  Just ans
  where
    field  =  accumArray (flip const) (m+1) ((1,1), (n,n)) (zip points [1..])
    ans  =  foldl' min (m+1) $
        [foldl' max 0 [field ! (i+di, j+dj) | (di, dj) <- smallSquare] | i <- [1..n-2], j <- [1..n-2]]
    smallSquare  =  [(i,j) | i <- [0..2], j <- [0..2]]

readPair :: String -> (Int, Int)
readPair s  =  reads' 0 s
  where
    reads' a (' ':s)  =  reads'' a 0 (dropWhile (== ' ') s)
    reads' a (c:s)
      | isDigit c  =  reads' (10*a + ord c - ord '0') s
      | otherwise  =  error $ concat ["readPair: unknown symbol ", show c]
    reads'' a b []  =  (a, b)
    reads'' a b (c:s)
      | isDigit c  =  reads'' a (10*b + ord c - ord '0') s
      | otherwise  =  error $ concat ["readPair: unknown symbol ", show c]

printAns :: Maybe Int -> IO ()
printAns  =  print . fromMaybe (-1)

main :: IO ()
main  =  do
--    timeStart  <-  getCPUTime

    lines'  <-  liftM lines getContents
    let [n, m]  =  map read $ words $ head lines'
    let ps  =  take m $ map readPair $ tail lines'
    printAns $ solve n m ps

--    timeEnd  <-  getCPUTime
--    hPutStrLn stderr $ concat ["Time = ", show $ fromIntegral (timeEnd - timeStart) / (10^12), " sec."]

import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S

readInt s = let Just (n,_) = B.readInt s in n

toPairs [] = []
toPairs (x:y:xys) = (x,y):toPairs xys

main=B.getContents>>=print.solve S.empty.zip[1..].tail.toPairs.map readInt.B.words

solve _ [] = -1
solve visited ((i,(x,y)):ixys)
  | any isSquare $ neighbors (x,y) = i
  | otherwise = solve visited' ixys
   where
     visited' = S.insert (x,y) visited
     isSquare = all(`S.member`visited').neighbors
     neighbors (x,y) = [(x+dx,y+dy)|dx<-[-1,0,1],dy<-[-1,0,1]]

import Array
import Control.Monad (liftM, replicateM)
import CPUTime
import Data.List (foldl1')
import Data.Map (Map, fromList, findWithDefault)

--------------------------------------------------------------------------------
{-
import HUnit

testSimple :: Test
testSimple  =  TestList "TestSimple" $
  [
    Test "1" $ assertEq (Just 9) $
        solve 3 9 [(i, j) | i <- [1..3], j <- [1..3]],
    Test "2" $ assertEq Nothing $
        solve 3 1 [(1,1)],
    Test "3" $ assertEq Nothing $
        solve 3 8 [(i,j) | i <- [1..3], j <- [1..3], i /= 2 || j /= 2]
  ]

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq (Just 10) $ solve 4 11
      [(1,1), (1,2), (1,3), (2,2), (2,3), (1,4), (2,4), (3,4), (3,2), (3,3), (4,1)],
    Test "2" $ assertEq Nothing $ solve 4 12
      [(1,1), (1,2), (1,3), (2,2), (2,3), (1,4), (2,4), (3,4), (3,2), (4,2), (4,1), (3,1)]
  ]

testSmallField :: Test
testSmallField  =  Test "TestSmallField" $
  assertEq Nothing $ solve 2 4 [(2,1),(1,2),(2,2),(1,1)]

testBigField :: Test
testBigField  =  Test "TestBigField" $
  assertEq Nothing $ solve 1000 1 [(1000,1000)]

testManyPoints :: Test
testManyPoints  =  Test "TestManyPoints" $
  assertEq (Just 9) $ solve 3 n $
    take n $ cycle [(i, j) | i <- [1..3], j <- [1..3]]
  where
    n  =  10^5

testBig :: Test
testBig  =  Test "TestBig" $
  assertEq (Just 2003) $ solve 1000 n $
    take n [(i, j) | i <- [1..1000], j <- [1..1000]]
  where
    n  =  10^5

test :: IO ()
test  =  mapM_ run
  [
    testSimple,
    testInput,
    testSmallField,
    testBigField,
    testManyPoints,
    testBig
  ]
-}
--------------------------------------------------------------------------------

getField :: Int -> Array Int (Int, Int) -> Array (Int, Int) Int
getField size points
  =  accumArray (flip const) maxBound ((1,1), (size, size))
    [(points ! i, i) | i <- [1..n]]
  where
    n  =  snd $ bounds points

solve  =  solve5

solve1 :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve1 n countPoints points
  | not $ containSquare countPoints  =  Nothing
  | otherwise  =  Just $ binSearch 8 countPoints
  where
    binSearch l r
      | l + 1 == r  =  r
      | containSquare m  =  binSearch l m
      | otherwise  =  binSearch m r
      where
        m  =  div (l+r) 2
    containSquare x  =  not $ null
      [(i,j) | i <- _1n2, j <- _1n2,
        all (\(di, dj) -> field ! (i+di, j+dj) <= x)
          [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]]
    field  =  getField n $ listArray (1,countPoints) points
    _1n2  =  [1..n-2]

solve2 :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve2 n countPoints points
  | ans == maxBound  =  Nothing
  | otherwise  =  Just ans
  where
    ans  =  minimum' $ maxBound :
      [myMaximum (map (\(di,dj) -> field ! (i+di, j+dj))
        [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)])
          | i <- [1..n-2], j <- [1..n-2]]
    field  =  getField n $ listArray (1,countPoints) points
    minimum'  =  foldl1' min
    myMaximum [x]  =  x
    myMaximum (x:xs)
      | x == maxBound  =  maxBound
      | otherwise  =  max x $ myMaximum xs

solve3 :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve3 n countPoints points
  | ans == maxBound  =  Nothing
  | otherwise  =  Just ans
  where
    field  =  getField n $ listArray (1,countPoints) points
    ans  =  foldl1' min $ maxBound : [d ! (i, j, 3, 3) | i <- [3..n], j <- [3..n]]
    d  =  array ((1,1,1,1), (n,n,3,3)) $
      [((i,j,di,dj), getD i j di dj) | i <- [1..n], j <- [1..n], di <- [1..3], dj <- [1..3]]
      where
        getD i j 1 1  =  field ! (i, j)
        getD i j 1 dj  =  max (d ! (i, j, 1, dj - 1)) (d ! (i, j + 1 - dj, 1, 1))
        getD i j di dj  =  max (d ! (i, j, di - 1, dj)) (d ! (i + 1 - di, j, 1, dj))

solve4 :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve4 n countPoints points
  | ans == maxBound  =  Nothing
  | otherwise  =  Just ans
  where
    arrayPoints  =  listArray (1,countPoints) points
    mapPoints  =  fromList [(arrayPoints ! i, i) | i <- [1..countPoints]]
    ans  =  minimum' $ maxBound :
      [maximum' [findWithDefault maxBound (i+di, j+dj) mapPoints
        | di <- [0..2], dj <- [0..2]]
          | i <- [1..n-2], j <- [1..n-2]]
    minimum'  =  foldl1' min
    maximum'  =  foldl1' max

solve5 :: Int -> Int -> [(Int, Int)] -> Maybe Int
solve5 n countPoints points
  | ans == maxBound  =  Nothing
  | otherwise  =  Just ans
  where
    field  =  getField n $ listArray (1,countPoints) points
    ans  =  solve' maxBound 1 1
    solve' min' i j
      | j > n - 2  =  min'
      | i > n - 2  =  solve' min' (i+1) 1
      | max' == maxBound && j > 2  =  solve' min' i (j+3)
      | otherwise  =  solve' (min max' min') i (j+1)
      where
        max'  =  myMaximum min' [field ! (i+di, j+dj) | (di, dj) <- [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]]
    myMaximum min' [x]  =  x
    myMaximum min' (x:xs)
      | x >= min'  =  maxBound
      | x == maxBound  =  maxBound
      | otherwise  =  max x $ myMaximum min' xs

readPair :: IO (Int, Int)
readPair  =  do
    [x, y]  <-  liftM (map read . words) getLine
    return (x, y)

printAns :: Maybe Int -> IO ()
printAns Nothing  =  print (-1)
printAns (Just x)  =  print x

main :: IO ()
main  =  do
--    timeStart  <-  getCPUTime

    (n, m)  <-  readPair
    points  <-  replicateM m readPair
    printAns $ solve n m points

--    timeEnd  <-  getCPUTime
--    putStrLn $ concat ["Time = ", show $ fromIntegral (timeEnd - timeStart) / (10^12), " sec."]


answer a | elem 1 a = -1
         | otherwise = 1
main = do
  w <- getLine
  let n = read w::Int
  ww <- getLine
  let a = [read n::Int|n <- (words ww)]
  print $ answer a

main :: IO()
main = print . solve . tail . map read . words =<< getContents

solve :: [Int] -> Int
solve []    = 1
solve (a:s) = if a == 1 then -1 else (solve s)

module Main where

import Data.List

main = do
    n <- fmap (\x -> read x :: Int) getLine
    vals <- fmap (\ln -> map (\x -> read x :: Int) (words ln)) getLine
    let sorted = sort vals
    print $ if head sorted == 1 then -1 else 1

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    if minimum a == 1 then putStrLn "-1" else putStrLn "1"

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  print $ if 1 `elem` xs then -1 else 1

import Data.Functor

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

main = getInts >>= putStrLn . show . solve

solve (_:xs) = if elem 1 xs then -1 else 1

main = interact $ show . foldl (\ns a -> if a == 1 then -1 else ns) 1 . map read . words . last . lines

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
someFunc::IO()
someFunc = getLine >> (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInt).C.words<$>C.getLine))
solve xs = let ss =sort xs; h=head ss in if h==1 then print (-1) else print 1

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve xs = if 1 `elem` xs then -1 else 1

import Data.List (sort)
main = do
    getLine
    ns <- fmap (sort . map read . words) getLine
    putStrLn $ if head ns == 1 then "-1" else "1"

main = getLine >> fmap (map read . words) getLine >>= print . f
f xs = if 1 `elem` xs then -1 else 1

import Data.List
main = do
     getLine
     x <-  getLine
     if not (filter (\y-> y==1)(map (read) (words x)) == []) then print (-1) else print 1

main = getContents >>= print . solve . map read . tail . words

solve as = if any (== 1) as then -1 else 1

f 1 = -1
f _ = 1
main=interact$show.f.minimum.map read.tail.words

import Data.List

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

manip xs
	| 1 `elem` xs = -1
	| otherwise = 1

main = do
    n <- getLine
    ints <- readInts
    print $ manip ints

import Control.Applicative (liftA, (<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

curSys :: [Int] -> Int
curSys = (\a-> if a == 1 then -1 else 1) . minimum

parse :: B.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

main :: IO ()
main = getLine >> parse <$> B.getLine >>= \(Just a) -> print . curSys $ a

import Control.Monad

main = do
    getLine
    l <- getLine >>= return . map read . words
    print $ if minimum l == 1 then -1 else 1

import Control.Applicative

main= do
	 getLine
	 s<-map read. words <$> getContents::IO [Int]
	 putStrLn $ if (elem 1 s) then "-1" else "1"

main = do
  getLine
  a <- getLine >>= return. map read. words :: IO [Int]
  putStrLn (if elem 1 a then "-1" else "1")

module Main where

import Control.Applicative

solve lst
    | minimum lst == 1 = -1
    | otherwise = 1

main :: IO ()
main = do
    _ <- getLine
    lst <- (map (\s -> read s::Int) . words) <$> getLine
    print $ solve lst

parse :: String -> [Int]
parse contents = map read . words $ a
                 where [_, a] = lines contents

bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True  = t

solve :: [Int] -> Int
solve = bool 1 (-1) . (== 1) . minimum

main :: IO ()
main = print . solve . parse =<< getContents

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    if minimum a == 1 then putStrLn "-1" else print . pred . minimum $ a

import Data.Functor

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

main = getInts >>= putStrLn . show . solve

solve (_:x:_) = if x == 1 then -1 else 1

import Data.List
main = do
     getLine
     x <-  getLine
     if not (filter (\y-> y==1)(map (read) (words x)) == []) then print "-1" else print "1"

import Data.List

f (x:y:xs) | x+1 < y = x+1
           | otherwise = f (x+y:xs)
f _ = -1
main=interact$show.f.sort.map((+0).read).tail.words

import Data.List

f (x:y:xs) | x+1 < y = x+1
           | otherwise = f (x+y:xs)
f _ = -1
main=interact$show.f.(0:).sort.map((+0).read).tail.words

f 1 = 1
f _ = -1
main=interact$show.f.minimum.map read.tail.words

import Control.Applicative (liftA, (<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

curSys :: [Int] -> Int
curSys = (\a-> if a == 1 then -1 else 1) . foldr1 gcd

parse :: B.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

main :: IO ()
main = getLine >> parse <$> B.getLine >>= \(Just a) -> print . curSys $ a

import Control.Applicative (liftA, (<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

curSys :: [Int] -> Int
curSys = (\a-> if a == 1 then -1 else a) . foldr1 gcd

parse :: B.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

main :: IO ()
main = getLine >> parse <$> B.getLine >>= \(Just a) -> print . curSys $ a

m 1 = -1
m x = x - 1
main = do
  getLine
  a <- getLine >>= return. map read. words :: IO [Int]
  print.m.minimum $ a

main = do
  getLine
  a <- getLine >>= return. map read. words :: IO [Int]
  print (if elem 1 a then "-1" else "1")

main = do
  getLine
  a <- getLine >>= return. map read. words :: IO [Int]
  print (if elem 1 a then "YES" else "NO")