Levko loves array a1, a2, ... , an, consisting of integers, very much. That is why Levko is playing with array a, performing all sorts of operations with it. Each operation Levko performs is of one of two types:  Increase all elements from li to ri by di. In other words, perform assignments aj = aj + di for all j that meet the inequation li ≤ j ≤ ri.  Find the maximum of elements from li to ri. That is, calculate the value . Sadly, Levko has recently lost his array. Fortunately, Levko has records of all operations he has performed on array a. Help Levko, given the operation records, find at least one suitable array. The results of all operations for the given array must coincide with the record results. Levko clearly remembers that all numbers in his array didn't exceed 109 in their absolute value, so he asks you to find such an array.

The first line contains two integers n and m (1 ≤ n, m ≤ 5000) — the size of the array and the number of operations in Levko's records, correspondingly. Next m lines describe the operations, the i-th line describes the i-th operation. The first integer in the i-th line is integer ti (1 ≤ ti ≤ 2) that describes the operation type. If ti = 1, then it is followed by three integers li, ri and di (1 ≤ li ≤ ri ≤ n,  - 104 ≤ di ≤ 104) — the description of the operation of the first type. If ti = 2, then it is followed by three integers li, ri and mi (1 ≤ li ≤ ri ≤ n,  - 5·107 ≤ mi ≤ 5·107) — the description of the operation of the second type. The operations are given in the order Levko performed them on his array.

In the first line print "YES" (without the quotes), if the solution exists and "NO" (without the quotes) otherwise. If the solution exists, then on the second line print n integers a1, a2, ... , an (|ai| ≤ 109) — the recovered array.

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

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


Martha — as a professional problemsetter — proposed a problem for a world-class contest. This is the problem statement:Tomorrow is Nadia's birthday, and Bardia (her brother) is assigned to make the balloons ready!There are n balloons (initially empty) that are tied to a straight line on certain positions x1, x2, ..., xn. Bardia inflates the balloons from left to right. As a result, i-th balloon gets bigger and bigger until its radius reaches the pressure endurance pi or it touches another previously-inflated balloon.  While Bardia was busy with the balloons, he wondered "What will be the sum of radius of balloons after all of the balloons are inflated?". Being a nerdy type of guy, he is now thinking about the problem instead of preparing his sister's birthday. Calculate the answer to Bardia's problem so that Nadia's birthday won't be balloon-less.Artha — Martha's student — claimed his solution got accepted. Martha (being his teacher for a long time!) knew he couldn't have solved the problem for real and thus thinks there is something wrong with the testcases. Artha isn't anyhow logical, which means there is no way for Martha to explain the wrong point in his algorithm. So, the only way is to find a testcase to prove him wrong!Artha's pseudo-code is shown below:  You should output a small testcase for the problem such that Artha's algorithm is incorrect. The algorithm's output is considered correct if it differs from the correct value by no more than 1.

Please pay attention! No input will be given to your program for this problem. So you do not have to read from the input anything.

You should output the generated small testcase (which Artha's solution doesn't get it right). It should be in the following format:   First line must contain the only number n (1 ≤ n ≤ 500).  The i-th of the next n lines should contain the description of the i-th balloon — two space-separated integers xi, pi (1 ≤ pi ≤ 106, 0 ≤ x1 < x2 < ... < xn ≤ 106).

NoteThe testcase depicted in the figure above (just showing how output should be formatted):40 96 312 717 1


Four players participate in the playoff tournament. The tournament is held according to the following scheme: the first player will play with the second, and the third player with the fourth, then the winners of the pairs will play in the finals of the tournament.It is known that in a match between two players, the one whose skill is greater will win. The skill of the $$$i$$$-th player is equal to $$$s_i$$$ and all skill levels are pairwise different (i. e. there are no two identical values in the array $$$s$$$).The tournament is called fair if the two players with the highest skills meet in the finals.Determine whether the given tournament is fair.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. A single line of test case contains four integers $$$s_1, s_2, s_3, s_4$$$ ($$$1 \le s_i \le 100$$$) — skill of the players. It is guaranteed that all the numbers in the array are different.

For each testcase, output YES if the tournament is fair, or NO otherwise.

NoteConsider the example:  in the first test case, players $$$2$$$ and $$$3$$$ with skills $$$7$$$ and $$$9$$$ advance to the finals;  in the second test case, players $$$2$$$ and $$$4$$$ with skills $$$5$$$ and $$$9$$$ advance to the finals. The player with skill $$$6$$$ does not advance, but the player with skill $$$5$$$ advances to the finals, so the tournament is not fair;  in the third test case, players $$$1$$$ and $$$3$$$ with skills $$$5$$$ and $$$8$$$ advance to the finals;  in the fourth test case, players $$$1$$$ and $$$3$$$ with skills $$$6$$$ and $$$3$$$ advance to the finals. The player with skill $$$5$$$ does not advance, but the player with skill $$$3$$$ advances to the finals, so the tournament is not fair.

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


Ivan recently bought a detective book. The book is so interesting that each page of this book introduces some sort of a mystery, which will be explained later. The $$$i$$$-th page contains some mystery that will be explained on page $$$a_i$$$ ($$$a_i \ge i$$$).Ivan wants to read the whole book. Each day, he reads the first page he didn't read earlier, and continues to read the following pages one by one, until all the mysteries he read about are explained and clear to him (Ivan stops if there does not exist any page $$$i$$$ such that Ivan already has read it, but hasn't read page $$$a_i$$$). After that, he closes the book and continues to read it on the following day from the next page.How many days will it take to read the whole book?

The first line contains single integer $$$n$$$ ($$$1 \le n \le 10^4$$$) — the number of pages in the book. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$i \le a_i \le n$$$), where $$$a_i$$$ is the number of page which contains the explanation of the mystery on page $$$i$$$.

Print one integer — the number of days it will take to read the whole book.

NoteExplanation of the example test:During the first day Ivan will read only the first page. During the second day Ivan will read pages number $$$2$$$ and $$$3$$$. During the third day — pages $$$4$$$-$$$8$$$. During the fourth (and the last) day Ivan will read remaining page number $$$9$$$.

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

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


Alice and Bob play ping-pong with simplified rules.During the game, the player serving the ball commences a play. The server strikes the ball then the receiver makes a return by hitting the ball back. Thereafter, the server and receiver must alternately make a return until one of them doesn't make a return.The one who doesn't make a return loses this play. The winner of the play commences the next play. Alice starts the first play.Alice has $$$x$$$ stamina and Bob has $$$y$$$. To hit the ball (while serving or returning) each player spends $$$1$$$ stamina, so if they don't have any stamina, they can't return the ball (and lose the play) or can't serve the ball (in this case, the other player serves the ball instead). If both players run out of stamina, the game is over.Sometimes, it's strategically optimal not to return the ball, lose the current play, but save the stamina. On the contrary, when the server commences a play, they have to hit the ball, if they have some stamina left.Both Alice and Bob play optimally and want to, firstly, maximize their number of wins and, secondly, minimize the number of wins of their opponent.Calculate the resulting number of Alice's and Bob's wins.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first and only line of each test case contains two integers $$$x$$$ and $$$y$$$ ($$$1 \le x, y \le 10^6$$$) — Alice's and Bob's initial stamina.

For each test case, print two integers — the resulting number of Alice's and Bob's wins, if both of them play optimally.

NoteIn the first test case, Alice serves the ball and spends $$$1$$$ stamina. Then Bob returns the ball and also spends $$$1$$$ stamina. Alice can't return the ball since she has no stamina left and loses the play. Both of them ran out of stamina, so the game is over with $$$0$$$ Alice's wins and $$$1$$$ Bob's wins.In the second test case, Alice serves the ball and spends $$$1$$$ stamina. Bob decides not to return the ball — he loses the play but saves stamina. Alice, as the winner of the last play, serves the ball in the next play and spends $$$1$$$ more stamina. This time, Bob returns the ball and spends $$$1$$$ stamina. Alice doesn't have any stamina left, so she can't return the ball and loses the play. Both of them ran out of stamina, so the game is over with $$$1$$$ Alice's and $$$1$$$ Bob's win.In the third test case, Alice serves the ball and spends $$$1$$$ stamina. Bob returns the ball and spends $$$1$$$ stamina. Alice ran out of stamina, so she can't return the ball and loses the play. Bob, as a winner, serves the ball in the next $$$6$$$ plays. Each time Alice can't return the ball and loses each play. The game is over with $$$0$$$ Alice's and $$$7$$$ Bob's wins.

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> (\[a,b] -> [a-1,b]) >>> map show >>> unwords) >>> unlines


You are given a string $$$t$$$ consisting of $$$n$$$ lowercase Latin letters and an integer number $$$k$$$.Let's define a substring of some string $$$s$$$ with indices from $$$l$$$ to $$$r$$$ as $$$s[l \dots r]$$$.Your task is to construct such string $$$s$$$ of minimum possible length that there are exactly $$$k$$$ positions $$$i$$$ such that $$$s[i \dots i + n - 1] = t$$$. In other words, your task is to construct such string $$$s$$$ of minimum possible length that there are exactly $$$k$$$ substrings of $$$s$$$ equal to $$$t$$$.It is guaranteed that the answer is always unique.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 50$$$) — the length of the string $$$t$$$ and the number of substrings. The second line of the input contains the string $$$t$$$ consisting of exactly $$$n$$$ lowercase Latin letters.

Print such string $$$s$$$ of minimum possible length that there are exactly $$$k$$$ substrings of $$$s$$$ equal to $$$t$$$. It is guaranteed that the answer is always unique.

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)

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


You had $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$ arranged in a circle. For each pair of neighboring numbers ($$$a_1$$$ and $$$a_2$$$, $$$a_2$$$ and $$$a_3$$$, ..., $$$a_{n - 1}$$$ and $$$a_n$$$, and $$$a_n$$$ and $$$a_1$$$), you wrote down: are the numbers in the pair equal or not.Unfortunately, you've lost a piece of paper with the array $$$a$$$. Moreover, you are afraid that even information about equality of neighboring elements may be inconsistent. So, you are wondering: is there any array $$$a$$$ which is consistent with information you have about equality or non-equality of corresponding pairs?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ cases follow. The first and only line of each test case contains a non-empty string $$$s$$$ consisting of characters E and/or N. The length of $$$s$$$ is equal to the size of array $$$n$$$ and $$$2 \le n \le 50$$$. For each $$$i$$$ from $$$1$$$ to $$$n$$$:    if $$$s_i =$$$ E then $$$a_i$$$ is equal to $$$a_{i + 1}$$$ ($$$a_n = a_1$$$ for $$$i = n$$$);  if $$$s_i =$$$ N then $$$a_i$$$ is not equal to $$$a_{i + 1}$$$ ($$$a_n \neq a_1$$$ for $$$i = n$$$).

For each test case, print YES if it's possible to choose array $$$a$$$ that are consistent with information from $$$s$$$ you know. Otherwise, print NO. It can be proved, that if there exists some array $$$a$$$, then there exists an array $$$a$$$ of positive integers with values less or equal to $$$10^9$$$.

NoteIn the first test case, you can choose, for example, $$$a_1 = a_2 = a_3 = 5$$$.In the second test case, there is no array $$$a$$$, since, according to $$$s_1$$$, $$$a_1$$$ is equal to $$$a_2$$$, but, according to $$$s_2$$$, $$$a_2$$$ is not equal to $$$a_1$$$.In the third test case, you can, for example, choose array $$$a = [20, 20, 4, 50, 50, 50, 20]$$$.In the fourth test case, you can, for example, choose $$$a = [1, 3, 3, 7]$$$.

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


You are given a sequence $$$a$$$, initially consisting of $$$n$$$ integers.You want to transform this sequence so that all elements in it are equal (i. e. it contains several occurrences of the same element).To achieve this, you choose some integer $$$x$$$ that occurs at least once in $$$a$$$, and then perform the following operation any number of times (possibly zero): choose some segment $$$[l, r]$$$ of the sequence and remove it. But there is one exception: you are not allowed to choose a segment that contains $$$x$$$. More formally, you choose some contiguous subsequence $$$[a_l, a_{l + 1}, \dots, a_r]$$$ such that $$$a_i \ne x$$$ if $$$l \le i \le r$$$, and remove it. After removal, the numbering of elements to the right of the removed segment changes: the element that was the $$$(r+1)$$$-th is now $$$l$$$-th, the element that was $$$(r+2)$$$-th is now $$$(l+1)$$$-th, and so on (i. e. the remaining sequence just collapses).Note that you can not change $$$x$$$ after you chose it.For example, suppose $$$n = 6$$$, $$$a = [1, 3, 2, 4, 1, 2]$$$. Then one of the ways to transform it in two operations is to choose $$$x = 1$$$, then:  choose $$$l = 2$$$, $$$r = 4$$$, so the resulting sequence is $$$a = [1, 1, 2]$$$;  choose $$$l = 3$$$, $$$r = 3$$$, so the resulting sequence is $$$a = [1, 1]$$$. Note that choosing $$$x$$$ is not an operation. Also, note that you can not remove any occurrence of $$$x$$$.Your task is to find the minimum number of operations required to transform the sequence in a way described above.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$).

For each test case, print the answer — the minimum number of operations required to transform the given sequence in a way described in the problem statement. It can be proven that it is always possible to perform a finite sequence of operations so the sequence is transformed in the required way.

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

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


Students of group 199 have written their lectures dismally. Now an exam on Mathematical Analysis is approaching and something has to be done asap (that is, quickly). Let's number the students of the group from 1 to n. Each student i (1 ≤ i ≤ n) has a best friend p[i] (1 ≤ p[i] ≤ n). In fact, each student is a best friend of exactly one student. In other words, all p[i] are different. It is possible that the group also has some really "special individuals" for who i = p[i].Each student wrote exactly one notebook of lecture notes. We know that the students agreed to act by the following algorithm:   on the first day of revising each student studies his own Mathematical Analysis notes,  in the morning of each following day each student gives the notebook to his best friend and takes a notebook from the student who calls him the best friend. Thus, on the second day the student p[i] (1 ≤ i ≤ n) studies the i-th student's notes, on the third day the notes go to student p[p[i]] and so on. Due to some characteristics of the boys' friendship (see paragraph 1), each day each student has exactly one notebook to study.You are given two sequences that describe the situation on the third and fourth days of revising:  a1, a2, ..., an, where ai means the student who gets the i-th student's notebook on the third day of revising;  b1, b2, ..., bn, where bi means the student who gets the i-th student's notebook on the fourth day of revising. You do not know array p, that is you do not know who is the best friend to who. Write a program that finds p by the given sequences a and b.

The first line contains integer n (1 ≤ n ≤ 105) — the number of students in the group. The second line contains sequence of different integers a1, a2, ..., an (1 ≤ ai ≤ n). The third line contains the sequence of different integers b1, b2, ..., bn (1 ≤ bi ≤ n).

Print sequence n of different integers p[1], p[2], ..., p[n] (1 ≤ p[i] ≤ n). It is guaranteed that the solution exists and that it is unique.

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)

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)


You are given a graph with $$$3 \cdot n$$$ vertices and $$$m$$$ edges. You are to find a matching of $$$n$$$ edges, or an independent set of $$$n$$$ vertices.A set of edges is called a matching if no two edges share an endpoint.A set of vertices is called an independent set if no two vertices are connected with an edge.

The first line contains a single integer $$$T \ge 1$$$ — the number of graphs you need to process. The description of $$$T$$$ graphs follows. The first line of description of a single graph contains two integers $$$n$$$ and $$$m$$$, where $$$3 \cdot n$$$ is the number of vertices, and $$$m$$$ is the number of edges in the graph ($$$1 \leq n \leq 10^{5}$$$, $$$0 \leq m \leq 5 \cdot 10^{5}$$$). Each of the next $$$m$$$ lines contains two integers $$$v_i$$$ and $$$u_i$$$ ($$$1 \leq v_i, u_i \leq 3 \cdot n$$$), meaning that there is an edge between vertices $$$v_i$$$ and $$$u_i$$$. It is guaranteed that there are no self-loops and no multiple edges in the graph. It is guaranteed that the sum of all $$$n$$$ over all graphs in a single test does not exceed $$$10^{5}$$$, and the sum of all $$$m$$$ over all graphs in a single test does not exceed $$$5 \cdot 10^{5}$$$.

Print your answer for each of the $$$T$$$ graphs. Output your answer for a single graph in the following format. If you found a matching of size $$$n$$$, on the first line print "Matching" (without quotes), and on the second line print $$$n$$$ integers — the indices of the edges in the matching. The edges are numbered from $$$1$$$ to $$$m$$$ in the input order. If you found an independent set of size $$$n$$$, on the first line print "IndSet" (without quotes), and on the second line print $$$n$$$ integers — the indices of the vertices in the independent set. If there is no matching and no independent set of the specified size, print "Impossible" (without quotes). You can print edges and vertices in any order. If there are several solutions, print any. In particular, if there are both a matching of size $$$n$$$, and an independent set of size $$$n$$$, then you should print exactly one of such matchings or exactly one of such independent sets.

Matching
2
IndSet
1
IndSet
2 4
Matching
1 15

NoteThe first two graphs are same, and there are both a matching of size 1 and an independent set of size 1. Any of these matchings and independent sets is a correct answer.The third graph does not have a matching of size 2, however, there is an independent set of size 2. Moreover, there is an independent set of size 5: 2 3 4 5 6. However such answer is not correct, because you are asked to find an independent set (or matching) of size exactly $$$n$$$.The fourth graph does not have an independent set of size 2, but there is a matching of size 2.

import Data.Bits
import Control.Monad
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = do
  t <- readI <$> B.getLine
  replicateM_ t $ do
    [n,m] <- map readI . B.words <$> B.getLine
    es <- replicateM m (map readI . B.words <$> B.getLine)
    let (matchV,matchE) = foldl go (0 :: Integer,[]) (zip [1..] es)
    if length matchE >= n
      then do
        putStrLn "Matching"
        putStrLn $ unwords $ map show $ take n matchE
      else do
        putStrLn "IndSet"
        putStrLn $ unwords $ map show $ take n $ filter (not . testBit matchV) [1..3*n]
go (vs,es) (e,[u,v]) | testBit vs u || testBit vs v = (vs,es)
                     | otherwise = (vs `setBit` u `setBit` v,e:es)

import Data.Bits
import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [n,m] <- map read . words <$> getLine
    es <- replicateM m (map read . words <$> getLine)
    let (matchV,matchE) = foldl go (0 :: Integer,[]) (zip [1..] es)
    if length matchE >= n
      then do
        putStrLn "Matching"
        putStrLn $ unwords $ map show matchE
      else do
        putStrLn "IndSet"
        putStrLn $ unwords $ map show $ filter (not . testBit matchV) [1..3*n]
go (vs,es) (e,[u,v]) | testBit vs u || testBit vs v = (vs,es)
                     | otherwise = (vs `setBit` u `setBit` v,e:es)


There is an array $$$a$$$ with $$$n-1$$$ integers. Let $$$x$$$ be the bitwise XOR of all elements of the array. The number $$$x$$$ is added to the end of the array $$$a$$$ (now it has length $$$n$$$), and then the elements are shuffled.You are given the newly formed array $$$a$$$. What is $$$x$$$? If there are multiple possible values of $$$x$$$, you can output any of them.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the number of integers in the resulting array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 127$$$) — the elements of the newly formed array $$$a$$$. Additional constraint on the input: the array $$$a$$$ is made by the process described in the statement; that is, some value of $$$x$$$ exists.

For each test case, output a single integer — the value of $$$x$$$, as described in the statement. If there are multiple possible values of $$$x$$$, output any of them.

NoteIn the first test case, one possible array $$$a$$$ is $$$a=[2, 5, 4]$$$. Then $$$x = 2 \oplus 5 \oplus 4 = 3$$$ ($$$\oplus$$$ denotes the bitwise XOR), so the new array is $$$[2, 5, 4, 3]$$$. Afterwards, the array is shuffled to form $$$[4, 3, 2, 5]$$$.In the second test case, one possible array $$$a$$$ is $$$a=[1, 10, 6, 10]$$$. Then $$$x = 1 \oplus 10 \oplus 6 \oplus 10 = 7$$$, so the new array is $$$[1, 10, 6, 10, 7]$$$. Afterwards, the array is shuffled to form $$$[6, 1, 10, 7, 10]$$$.In the third test case, all elements of the array are equal to $$$6$$$, so $$$x=6$$$.In the fourth test case, one possible array $$$a$$$ is $$$a=[100, 100]$$$. Then $$$x = 100 \oplus 100 = 0$$$, so the new array is $$$[100, 100, 0]$$$. Afterwards, the array is shuffled to form $$$[100, 100, 0]$$$. (Note that after the shuffle, the array can remain the same.)

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]

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

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


Parsa has a humongous tree on $$$n$$$ vertices.On each vertex $$$v$$$ he has written two integers $$$l_v$$$ and $$$r_v$$$.To make Parsa's tree look even more majestic, Nima wants to assign a number $$$a_v$$$ ($$$l_v \le a_v \le r_v$$$) to each vertex $$$v$$$ such that the beauty of Parsa's tree is maximized.Nima's sense of the beauty is rather bizarre. He defines the beauty of the tree as the sum of $$$|a_u - a_v|$$$ over all edges $$$(u, v)$$$ of the tree.Since Parsa's tree is too large, Nima can't maximize its beauty on his own. Your task is to find the maximum possible beauty for Parsa's tree.

The first line contains an integer $$$t$$$ $$$(1\le t\le 250)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ $$$(2\le n\le 10^5)$$$ — the number of vertices in Parsa's tree. The $$$i$$$-th of the following $$$n$$$ lines contains two integers $$$l_i$$$ and $$$r_i$$$ $$$(1 \le l_i \le r_i \le 10^9)$$$. Each of the next $$$n-1$$$ lines contains two integers $$$u$$$ and $$$v$$$ $$$(1 \le u , v \le n, u\neq v)$$$ meaning that there is an edge between the vertices $$$u$$$ and $$$v$$$ in Parsa's tree. It is guaranteed that the given graph is a tree. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case print the maximum possible beauty for Parsa's tree.

NoteThe trees in the example:  In the first test case, one possible assignment is $$$a = \{1, 8\}$$$ which results in $$$|1 - 8| = 7$$$.In the second test case, one of the possible assignments is $$$a = \{1, 5, 9\}$$$ which results in a beauty of $$$|1 - 5| + |5 - 9| = 8$$$

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)


One not particularly beautiful evening Valera got very bored. To amuse himself a little bit, he found the following game.He took a checkered white square piece of paper, consisting of n × n cells. After that, he started to paint the white cells black one after the other. In total he painted m different cells on the piece of paper. Since Valera was keen on everything square, he wondered, how many moves (i.e. times the boy paints a square black) he should make till a black square with side 3 can be found on the piece of paper. But Valera does not know the answer to this question, so he asks you to help him.Your task is to find the minimum number of moves, till the checkered piece of paper has at least one black square with side of 3. Otherwise determine that such move does not exist.

The first line contains two integers n and m (1 ≤ n ≤ 1000, 1 ≤ m ≤ min(n·n, 105)) — the size of the squared piece of paper and the number of moves, correspondingly.  Then, m lines contain the description of the moves. The i-th line contains two integers xi, yi (1 ≤ xi, yi ≤ n) — the number of row and column of the square that gets painted on the i-th move.  All numbers on the lines are separated by single spaces. It is guaranteed that all moves are different. The moves are numbered starting from 1 in the order, in which they are given in the input. The columns of the squared piece of paper are numbered starting from 1, from the left to the right. The rows of the squared piece of paper are numbered starting from 1, from top to bottom.

On a single line print the answer to the problem — the minimum number of the move after which the piece of paper has a black square with side 3. If no such move exists, print -1.

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


A magic island Geraldion, where Gerald lives, has its own currency system. It uses banknotes of several values. But the problem is, the system is not perfect and sometimes it happens that Geraldionians cannot express a certain sum of money with any set of banknotes. Of course, they can use any number of banknotes of each value. Such sum is called unfortunate. Gerald wondered: what is the minimum unfortunate sum?

The first line contains number n (1 ≤ n ≤ 1000) — the number of values of the banknotes that used in Geraldion.  The second line contains n distinct space-separated numbers a1, a2, ..., an (1 ≤ ai ≤ 106) — the values of the banknotes.

Print a single line — the minimum unfortunate sum. If there are no unfortunate sums, print  - 1.

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

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

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


A star is a figure of the following type: an asterisk character '*' in the center of the figure and four rays (to the left, right, top, bottom) of the same positive length. The size of a star is the length of its rays. The size of a star must be a positive number (i.e. rays of length $$$0$$$ are not allowed).Let's consider empty cells are denoted by '.', then the following figures are stars:  The leftmost figure is a star of size $$$1$$$, the middle figure is a star of size $$$2$$$ and the rightmost figure is a star of size $$$3$$$. You are given a rectangular grid of size $$$n \times m$$$ consisting only of asterisks '*' and periods (dots) '.'. Rows are numbered from $$$1$$$ to $$$n$$$, columns are numbered from $$$1$$$ to $$$m$$$. Your task is to draw this grid using any number of stars or find out that it is impossible. Stars can intersect, overlap or even coincide with each other. The number of stars in the output can't exceed $$$n \cdot m$$$. Each star should be completely inside the grid. You can use stars of same and arbitrary sizes.In this problem, you do not need to minimize the number of stars. Just find any way to draw the given grid with at most $$$n \cdot m$$$ stars.

The first line of the input contains two integers $$$n$$$ and $$$m$$$ ($$$3 \le n, m \le 100$$$) — the sizes of the given grid. The next $$$n$$$ lines contains $$$m$$$ characters each, the $$$i$$$-th line describes the $$$i$$$-th row of the grid. It is guaranteed that grid consists of characters '*' and '.' only.

If it is impossible to draw the given grid using stars only, print "-1". Otherwise in the first line print one integer $$$k$$$ ($$$0 \le k \le n \cdot m$$$) — the number of stars needed to draw the given grid. The next $$$k$$$ lines should contain three integers each — $$$x_j$$$, $$$y_j$$$ and $$$s_j$$$, where $$$x_j$$$ is the row index of the central star character, $$$y_j$$$ is the column index of the central star character and $$$s_j$$$ is the size of the star. Each star should be completely inside the grid.

NoteIn the first example the output 23 4 13 5 2is also correct.

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

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

getInts :: IO [Int]
getInts = construct `fmap` BS.getLine

fastPrint :: Char -> [Int] -> IO ()
fastPrint mid arr = hPutBuilder stdout  $ build arr
    where build = foldr (\n b -> intDec n <> charUtf8 mid <> b) mempty

s !? x = Seq.index s x

s -! (x,y, m) = s !? (x*m + y)

getStar board n m x y
    | x >= n = []
    | y >= m = getStar board n m (x+1) 0
    | (board -! (x,y,m)) == '.' = getStar board n m x (y+1)
    | otherwise = star x y 1 : getStar board n m x (y+1)
    where star x y k = if x - k < 0 || x + k >= n || y - k < 0 || y + k >= m then [x,y,k-1]
                       else if (board -! (x-k,y, m)) /= '*' || (board -! (x+k,y, m)) /= '*' || (board -! (x,y-k, m)) /= '*' || (board -! (x,y+k, m)) /= '*' then [x,y,k-1]
                       else star x y (k+1)

make :: Int -> Int -> [[Int]] -> Seq.Seq Char -> Seq.Seq Char
make _ _ [] board = board
make n m (star:stars) board = make n m stars $ put star board
    where put star board = foldl (\b (x,y) -> Seq.update (x*m + y) '*' b) board [(x,y) | x <- [0..n-1], y <- [0..m-1], isIn star (x,y) ]
          isIn [x,y,k] (px,py) = if px == x then abs (py - y) <= k
                                 else if py == y then abs (px - x) <= k
                                 else False

main = do
    [n, m] <- getInts
    board <- replicateM n getLine
    let bseq = Seq.fromList (concat board)
    let stars = filter (\[x,y,z]-> z /= 0) $ getStar bseq n m 0 0
    let remake = make n m stars $ Seq.replicate (n*m) '.'
    if (F.toList remake) /= (concat board) then putStrLn "-1"
    else print (length stars) >> mapM_ putStrLn (map (intercalate " " . map show . (\[x,y,k]->[x+1,y+1,k])) stars)

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

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

getInts :: IO [Int]
getInts = construct `fmap` BS.getLine

fastPrint :: Char -> [Int] -> IO ()
fastPrint mid arr = hPutBuilder stdout  $ build arr
    where build = foldr (\n b -> intDec n <> charUtf8 mid <> b) mempty

s !? x = Seq.index s x

s -! (x,y,n) = s !? (x*n + y)

getStar board n m x y
    | x >= n = []
    | y >= m = getStar board n m (x+1) 0
    | (board -! (x,y, n)) == '.' = getStar board n m x (y+1)
    | otherwise = star x y 1 : getStar board n m x (y+1)
    where star x y k = if x - k < 0 || x + k >= n || y - k < 0 || y + k >= m then [x,y,k-1]
                       else if (board -! (x-k,y,n)) /= '*' || (board -! (x+k,y,n)) /= '*' || (board -! (x,y-k,n)) /= '*' || (board -! (x,y+k,n)) /= '*' then [x,y,k-1]
                       else star x y (k+1)

make :: Int -> Int -> [[Int]] -> Seq.Seq Char -> Seq.Seq Char
make _ _ [] board = board
make n m (star:stars) board = make n m stars $ put star board
    where newBoard star board = [s | x <- [0..n-1], y <- [0..m-1], let s = if isIn star (x,y) then '*' else board -! (x,y,n) ]
          put star board = Seq.fromList (newBoard star board)
          isIn [x,y,k] (px,py) = if px == x then abs (py - y) <= k
                                 else if py == y then abs (px - x) <= k
                                 else False

main = do
    [n, m] <- getInts
    board <- replicateM n getLine
    let bseq = Seq.fromList $ concat board
    let stars = filter (\[x,y,z]-> z /= 0) $ getStar bseq n m 0 0
    let remake = make n m stars $ Seq.replicate (n*m) '.'
    if F.toList remake /= concat board then putStrLn "-1"
    else print (length stars) >> mapM_ putStrLn (map (intercalate " " . map show . (\[x,y,k]->[x+1,y+1,k])) stars)