import qualified Data.ByteString.Char8 as B

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

main = B.getContents>>=putStrLn.unwords.map show.solve.zip[1..].tail.map readInt.B.words

solve :: [(Int,Int)] -> [Int]
solve ((i,x):(j,y):(k,z):rest)
  | x==y && y==z = solve ((j,y):(k,z):rest)
  | x==y = [j,k]
  | y==z || x<y && y<z || x>y && y>z = [i,j]
  | z/=x = [i,k]
  | null rest = [-1]
  | x == w = [j,k]
  | y == w = [i,j]
  | otherwise = [k,l]
   where
     (l,w) = head rest
solve _ = [-1]

-- Codeforces 252B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}

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

main :: IO ()
main = do
    n <- read <$> getLine :: IO Int
    xs <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents :: IO [Int]
    putStrLn . unwords . map show . go . zip [1..] $ xs
  where
    go ((x1,v1):(x2,v2):(x3,v3):vs)
      | v1 == v2 && v2 == v3 = go $ (x2,v2):(x3,v3):vs
      | v1 == v2 = [x2, x3]
      | v2 == v3 = [x1, x2]
      | v1 > v2 && v2 > v3 = [x1, x2]
      | v1 < v2 && v2 < v3 = [x1, x2]
      | v1 /= v3 = [x1, x3]
      | null vs = [-1]
      | v1 == v4 = [x2, x3]
      | v2 == v4 = [x1, x2]
      | v3 == v4 = [x2, x3]
      | otherwise = [x3, x4]
      where (x4, v4) = head vs
    go _ = [-1]

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

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

main = do
  n <- readLn :: IO Int
  if n<=2
     then print $ -1
     else B.getContents>>=putStrLn.unwords.map show.solve.zip[1..].map readInt.B.words

solve :: [(Int,Int)] -> [Int]
solve ((i,x):(j,y):(k,z):rest)
  | x==y && y==z = solve ((j,y):(k,z):rest)
  | x==y = [j,k]
  | y==z = [i,j]
  | z==x = solve ((i,x):(j,y):rest)
  | x<y  && y<z  = [i,j]
  | z>y  && y>x  = [i,j]
  | otherwise = [i,k]
solve _ = [-1]

import qualified Data.ByteString.Char8 as B

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

main = B.getContents>>=putStrLn.unwords.map show.solve.zip[1..].tail.map readInt.B.words

solve :: [(Int,Int)] -> [Int]
solve ((i,x):(j,y):(k,z):rest)
  | x==y && y==z = solve ((j,y):(k,z):rest)
  | x==y = [j,k]
  | y==z || x<y && y<z || x>y && y>z = [i,j]
  | z/=x = [i,k]
  | null rest = [-1]
  | y == w = [i,j]
  | otherwise = [k,l]
   where
     (l,w) = head rest
solve _ = [-1]


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

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

type Domain = (Int, [(Int, Int)])
type CoDomain = [Bool]
type Solver  = Domain -> CoDomain

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

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

printAns :: CoDomain -> IO ()
printAns = putStrLn . showResult

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

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

solve :: Solver
solve (m, xs) = result
  where
    mapAcc =  IntMap.unionsWith (+) $ (\(x,y) -> IntMap.fromList [(x-y, 1), (x, (-2)), (x+y, 1)]) <$> xs
    heights = tail $ toHeight <$> scanl f (0, 0, 0) (IntMap.toAscList mapAcc)
    highPoints = filter ((> m) . snd) heights
    leftMost = minimum $ (+m) <$> uncurry (-) <$> highPoints
    rightMost = maximum $ (+(-m)) <$> uncurry (+) <$> highPoints
    result = (\(x, y) -> null highPoints || x - y <= leftMost && x + y >= rightMost) <$> xs
    f (pos, ac, height) (nPos, acc) = (nPos, ac + acc, height + (nPos - pos) * ac)
    toHeight (xPos, _, height) = (xPos, height)

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

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

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

type Domain = (Int, [(Int, Int)])
type CoDomain = [Bool]
type Solver  = Domain -> CoDomain

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

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

printAns :: CoDomain -> IO ()
printAns = putStrLn . showResult

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

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

solve :: Solver
solve (m, xs) = result
  where
    mapAcc =  foldl' (\acc (x,y) -> IntMap.unionWith (+) (IntMap.fromList [(x-y, 1), (x, (-2)), (x+y, 1)]) acc) IntMap.empty xs
    heights = tail $ toHeight <$> scanl f (0, 0, 0) (IntMap.toAscList mapAcc)
    highPoints = filter ((> m) . snd) heights
    leftMost = minimum $ (+m) <$> uncurry (-) <$> highPoints
    rightMost = maximum $ (+(-m)) <$> uncurry (+) <$> highPoints
    result = (\(x, y) -> null highPoints || x - y <= leftMost && x + y >= rightMost) <$> xs
    f (pos, ac, height) (nPos, acc) = (nPos, ac + acc, height + (nPos - pos) * ac)
    toHeight (xPos, _, height) = (xPos, height)

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

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

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

type Domain = (Int, [(Int, Int)])
type CoDomain = [Bool]
type Solver  = Domain -> CoDomain

-- x in a
-- (x, y, a, b)
-- (start x, end x, start y, y per x unit )
type Segment = (Int, Int, Int, Int)

lookupSegGT :: Segment -> Set Segment -> Maybe Segment
lookupSegGT = goNothing
  where
    goNothing !_ Tip = Nothing
    goNothing x (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                              | otherwise = goNothing x r
    goJust !_ best Tip = Just best
    goJust x best (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                                | otherwise = goJust x best r

lookupIndexLt :: Segment -> Set Segment -> Int
lookupIndexLt x s = case Set.lookupLE x s of
  Just e -> fromJust $ Set.lookupIndex e s
  Nothing -> 0

lookupIndexGt :: Segment -> Set Segment -> Int
lookupIndexGt x s = case lookupSegGT x s of
  Just e -> 1 + fromJust (Set.lookupIndex e s)
  Nothing -> length s

splitSeg :: Segment -> Set Segment -> (Set Segment, Set Segment, Set Segment)
splitSeg x s = case Set.splitAt (lookupIndexLt x s) s of
  (l, xs) -> case Set.splitAt (lookupIndexGt x xs) xs of
    (overlap, r) -> (l, overlap, r)

notEmpty :: Segment -> Bool
notEmpty (x, y, a, b) = (x /= y) && (a /= 0 || b /= 0)

-- add two segments that intersected
addOrdered :: Segment -> (Segment, [Segment]) -> (Segment, [Segment])
addOrdered  a (b, acc) = case mergeSegment a b of
  (x, y) -> (x, y++acc)

negateSeg :: Segment -> Segment
negateSeg (x, y, a, b) = (x, y, -a, -b)

-- leave the right most part there
mergeSegment :: Segment -> Segment -> (Segment, [Segment])
mergeSegment a@(x1, y1, a1, b1) b@(x2, y2, a2, b2)
  -- a b
  | y1 <= x2 = (a, [b])
  -- b a
  | y2 <= x1 = mergeSegment b a
  -- a contains b
  -- as : bs, bs be; be ae
  | x1 <= x2 && y1 >= y2 = ((x1,x2,a1,b1), [(x2,y2,(x2-x1)*b1+a1+a2,b1+b2),(y2,y1,(y2-x1)*b1+a1,b1)])
  -- b contains a
  | x2 <= x1 && y2 >= y1 = mergeSegment b a
  -- insert a b
  | x1 <= x2 = ((x1,x2,a1,b1), ([(x2, y1, (x2-x1)*b1+a1+a2, b1+b2), (y1,y2,(y1-x2)*b2+a2, b2)]))
  | otherwise = mergeSegment b a

-- maintain none overlapping segments
toSegments :: Int -> Int  -> [Segment]
toSegments x p = [(x-p, x, 0, 1), (x, x + p, p, -1)]

-- find the left end pos, find the right end pos
-- merge all inner segments
addSegment :: Segment -> Set Segment -> Set Segment
addSegment x s = case (splitSeg x s) of
  (l, overlap, r) -> Set.fromAscList $ Set.toAscList l ++ insertSegment x (Set.toAscList overlap) ++ Set.toAscList r
    where
      insertSegment :: Segment -> [Segment] -> [Segment]
      insertSegment s xs =  filter notEmpty $ uncurry (:) $ foldr addOrdered (s, []) xs

-- xs - ys
removeSegments :: Set Segment -> [Segment] -> Set Segment
removeSegments xs ys = foldr subSegment xs ys
  where
    subSegment :: Segment -> Set Segment -> Set Segment
    subSegment s xs = addSegment (negateSeg s) xs

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

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

printAns :: CoDomain -> IO ()
printAns = putStrLn . showResult

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

-- solveOne :: Int -> Int -> Int -> [Int] -> Bool
-- solveOne total n m xs = (not (null ks) && (maximum ks) > 2 || even m) && sum ks >= m
--   where ks = filter (>1) $ map (`div` n) xs

getStart :: Segment -> Int
getStart (x, _, _, _) = x

getEnd :: Segment -> Int
getEnd (_, y, _, _) = y

getStartHeight :: Segment -> Int
getStartHeight (_, _, a, _) = a

getEndHeight :: Segment -> Int
getEndHeight (x1, x2, a, b) = a + (x2-x1) * b

getHeight :: Segment -> Int
getHeight s = max (getStartHeight s) (getEndHeight s)

containsPoint :: Int -> (Int, Int) -> Bool
containsPoint x (a,b) = a - b <= x && x <= a + b

getHighest :: Set Segment -> Maybe Segment
getHighest xs = if Set.null xs
  then Nothing
  else Just $ maximumBy (comparing getHeight) $ Set.toAscList  xs

getHeightPos :: Segment -> Int
getHeightPos (x1, x2, _, b)
  | b >= 0 = x2
  | otherwise = x1

-- (Height, height of the position)
computeHighPoint :: Set Segment -> (Int, Int)
computeHighPoint xs = case getHighest xs of
  Just seg -> (getHeight seg,  getHeightPos seg)
  Nothing -> (0, 0)

computeHigh :: Set Segment -> Int
computeHigh = fst . computeHighPoint

-- remove seg, height lower than m after removal
solveOne :: (Int,Int) -> Int -> Set Segment -> (Int, Int) -> Bool
solveOne (height, hightPos) m merged xs = (height <= m) || (containsPoint hightPos xs && (computeHigh $ removeSegments merged $ uncurry toSegments xs) <= m)

showResult :: [Bool] -> String
showResult xs =  map (bool '0' '1') xs

solve :: Solver
solve (m, xs) = result
  where
    mapAcc =  foldl' (\acc (x,y) -> IntMap.unionWith (+) (IntMap.fromList [(x-y, 1), (x, (-2)), (x+y, 1)]) acc) IntMap.empty xs
    heights = tail $ toHeight <$> scanl f (0, 0, 0) (IntMap.toAscList mapAcc)
    highPoints = filter ((> m) . snd) heights
    leftMost = minimum $ (+m) <$> uncurry (-) <$> highPoints
    rightMost = maximum $ (+(-m)) <$> uncurry (+) <$> highPoints
    result = (\(x, y) -> null highPoints || x - y <= leftMost && x + y >= rightMost) <$> xs
    f (pos, ac, height) (nPos, acc) = (nPos, ac + acc, height + (nPos - pos) * ac)
    toHeight (xPos, _, height) = (xPos, height)

solve1 :: Solver
solve1 (m, xs) =
  -- traceShow (m, xs, segments, computeHighPoint merged, ys)
  results
  where
        segments = concatMap (uncurry toSegments) xs
        merged = foldr addSegment Set.empty segments
        (height, hightPos) = computeHighPoint merged
        -- ys = (computeHigh . removeSegments merged . uncurry toSegments) <$> xs
        ys = traceShowId <$> (id &&& computeHigh) <$> (removeSegments merged . uncurry toSegments) <$> xs
        -- containsPointSegments = uncurry toSegments <$> filter (containsPoint hightPos) xs
        results = solveOne (height, hightPos) m merged <$> xs

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

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

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

type Domain = (Int, [(Int, Int)])
type CoDomain = [Bool]
type Solver  = Domain -> CoDomain

-- x in a
-- (x, y, a, b)
-- (start x, end x, start y, y per x unit )
type Segment = (Int, Int, Int, Int)

lookupSegGT :: Segment -> Set Segment -> Maybe Segment
lookupSegGT = goNothing
  where
    goNothing !_ Tip = Nothing
    goNothing x (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                              | otherwise = goNothing x r
    goJust !_ best Tip = Just best
    goJust x best (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                                | otherwise = goJust x best r

lookupIndexLt :: Segment -> Set Segment -> Int
lookupIndexLt x s = case Set.lookupLE x s of
  Just e -> fromJust $ Set.lookupIndex e s
  Nothing -> 0

lookupIndexGt :: Segment -> Set Segment -> Int
lookupIndexGt x s = case lookupSegGT x s of
  Just e -> 1 + fromJust (Set.lookupIndex e s)
  Nothing -> length s

splitSeg :: Segment -> Set Segment -> (Set Segment, Set Segment, Set Segment)
splitSeg x s = case Set.splitAt (lookupIndexLt x s) s of
  (l, xs) -> case Set.splitAt (lookupIndexGt x xs) xs of
    (overlap, r) -> (l, overlap, r)

notEmpty :: Segment -> Bool
notEmpty (x, y, a, b) = (x /= y) && (a /= 0 || b /= 0)

-- add two segments that intersected
addOrdered :: Segment -> (Segment, [Segment]) -> (Segment, [Segment])
addOrdered  a (b, acc) = case mergeSegment a b of
  (x, y) -> (x, y++acc)

negateSeg :: Segment -> Segment
negateSeg (x, y, a, b) = (x, y, -a, -b)

-- leave the right most part there
mergeSegment :: Segment -> Segment -> (Segment, [Segment])
mergeSegment a@(x1, y1, a1, b1) b@(x2, y2, a2, b2)
  -- a b
  | y1 <= x2 = (a, [b])
  -- b a
  | y2 <= x1 = mergeSegment b a
  -- a contains b
  -- as : bs, bs be; be ae
  | x1 <= x2 && y1 >= y2 = ((x1,x2,a1,b1), [(x2,y2,(x2-x1)*b1+a1+a2,b1+b2),(y2,y1,(y2-x1)*b1+a1,b1)])
  -- b contains a
  | x2 <= x1 && y2 >= y1 = mergeSegment b a
  -- insert a b
  | x1 <= x2 = ((x1,x2,a1,b1), ([(x2, y1, (x2-x1)*b1+a1+a2, b1+b2), (y1,y2,(y1-x2)*b2+a2, b2)]))
  | otherwise = mergeSegment b a

-- maintain none overlapping segments
toSegments :: Int -> Int  -> [Segment]
toSegments x p = [(x-p, x, 0, 1), (x, x + p, p, -1)]

-- find the left end pos, find the right end pos
-- merge all inner segments
addSegment :: Segment -> Set Segment -> Set Segment
addSegment x s = case (splitSeg x  s) of
  (l, overlap, r) -> Set.fromAscList $ Set.toAscList l ++ insertSegment x (Set.toAscList overlap) ++ Set.toAscList r
    where
      insertSegment :: Segment -> [Segment] -> [Segment]
      insertSegment s xs =  filter notEmpty $ uncurry (:) $ foldr addOrdered (s, []) xs

-- xs - ys
removeSegments :: Set Segment -> [Segment] -> Set Segment
removeSegments xs ys = foldr subSegment xs ys
  where
    subSegment :: Segment -> Set Segment -> Set Segment
    subSegment s xs = addSegment (negateSeg s) xs

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

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

printAns :: CoDomain -> IO ()
printAns = putStrLn . showResult

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

-- solveOne :: Int -> Int -> Int -> [Int] -> Bool
-- solveOne total n m xs = (not (null ks) && (maximum ks) > 2 || even m) && sum ks >= m
--   where ks = filter (>1) $ map (`div` n) xs

getStart :: Segment -> Int
getStart (x, _, _, _) = x

getEnd :: Segment -> Int
getEnd (_, y, _, _) = y

getStartHeight :: Segment -> Int
getStartHeight (_, _, a, _) = a

getEndHeight :: Segment -> Int
getEndHeight (x1, x2, a, b) = a + (x2-x1) * b

getHeight :: Segment -> Int
getHeight s = max (getStartHeight s) (getEndHeight s)

containsPoint :: Int -> (Int, Int) -> Bool
containsPoint x (a,b) = a - b <= x && x <= a + b

getHighest :: Set Segment -> Segment
getHighest xs = maximumBy (comparing getHeight) $ Set.toAscList  xs

getHeightPos :: Segment -> Int
getHeightPos (x1, x2, _, b)
  | b >= 0 = x2
  | otherwise = x1

-- (Height, height of the position)
computeHighPoint :: Set Segment -> (Int, Int)
computeHighPoint xs = (getHeight seg,  getHeightPos seg) where seg = getHighest xs

computeHigh :: Set Segment -> Int
computeHigh = fst . computeHighPoint

-- remove seg, height lower than m after removal
solveOne :: Int -> Int -> Set Segment -> (Int, Int) -> Bool
solveOne hightPoint m merged xs = containsPoint hightPoint xs && (computeHigh $ removeSegments merged $ uncurry toSegments xs) <= m

showResult :: [Bool] -> String
showResult xs =  map (bool '0' '1') xs

solve :: Solver
solve (m, xs) =
  -- traceShow (xs, segments, computeHighPoint merged, ys)
  results
  where
        segments = concatMap (uncurry toSegments) xs
        merged = foldr addSegment Set.empty segments
        hightPos = snd $ computeHighPoint merged
        -- ys = (computeHigh . removeSegments merged . uncurry toSegments) <$> xs
        -- ys = traceShowId <$> (id &&& computeHigh) <$> (removeSegments merged . uncurry toSegments) <$> xs
        -- containsPointSegments = uncurry toSegments <$> filter (containsPoint hightPos) xs
        results = solveOne hightPos m merged <$> xs

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

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

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

type Domain = (Int, [(Int, Int)])
type CoDomain = [Bool]
type Solver  = Domain -> CoDomain

-- x in a
-- (x, y, a, b)
-- (start x, end x, start y, y per x unit )
type Segment = (Int, Int, Int, Int)

lookupSegGT :: Segment -> Set Segment -> Maybe Segment
lookupSegGT = goNothing
  where
    goNothing !_ Tip = Nothing
    goNothing x (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                              | otherwise = goNothing x r
    goJust !_ best Tip = Just best
    goJust x best (Bin _ y l r) | (getEnd x) < (getEnd y) = goJust x y l
                                | otherwise = goJust x best r

lookupIndexLt :: Segment -> Set Segment -> Int
lookupIndexLt x s = case Set.lookupLE x s of
  Just e -> fromJust $ Set.lookupIndex e s
  Nothing -> 0

lookupIndexGt :: Segment -> Set Segment -> Int
lookupIndexGt x s = case lookupSegGT x s of
  Just e -> 1 + fromJust (Set.lookupIndex e s)
  Nothing -> length s

splitSeg :: Segment -> Set Segment -> (Set Segment, Set Segment, Set Segment)
splitSeg x s = case Set.splitAt (lookupIndexLt x s) s of
  (l, xs) -> case Set.splitAt (lookupIndexGt x xs) xs of
    (overlap, r) -> (l, overlap, r)

notEmpty :: Segment -> Bool
notEmpty (x, y, _, _) = not $ x == y

-- add two segments that intersected
addOrdered :: Segment -> (Segment, [Segment]) -> (Segment, [Segment])
addOrdered  a (b, acc) = case mergeSegment a b of
  (x, y) -> (x, y++acc)

negateSeg :: Segment -> Segment
negateSeg (x, y, a, b) = (x, y, -a, -b)

-- leave the right most part there
mergeSegment :: Segment -> Segment -> (Segment, [Segment])
mergeSegment a@(x1, y1, a1, b1) b@(x2, y2, a2, b2)
  -- a b
  | y1 <= x2 = (a, [b])
  -- b a
  | y2 <= x1 = mergeSegment b a
  -- a contains b
  -- as : bs, bs be; be ae
  | x1 <= x2 && y1 >= y2 = ((x1,x2,a1,b1), [(x2,y2,(x2-x1)*b1+a1+a2,b1+b2),(y2,y1,(y2-x1)*b1+a1,b1)])
  -- b contains a
  | x2 <= x1 && y2 >= y1 = mergeSegment b a
  -- insert a b
  | x1 <= x2 = ((x1,x2,a1,b1), ([(x2, y1, (x2-x1)*b1+a1+a2, b1+b2), (y1,y2,(y1-x2)*b2+a2, b2)]))
  | otherwise = mergeSegment b a

-- maintain none overlapping segments
toSegments :: Int -> Int  -> [Segment]
toSegments x p = [(x-p, x, 0, 1), (x, x + p, p, -1)]

-- find the left end pos, find the right end pos
-- merge all inner segments
addSegment :: Segment -> Set Segment -> Set Segment
addSegment x s = case (splitSeg x  s) of
  (l, overlap, r) -> Set.fromAscList $ Set.toAscList l ++ insertSegment x (Set.toAscList overlap) ++ Set.toAscList r
    where
      insertSegment :: Segment -> [Segment] -> [Segment]
      insertSegment s xs =  filter notEmpty $ uncurry (:) $ foldr addOrdered (s, []) xs

-- xs - ys
removeSegments :: Set Segment -> [Segment] -> Set Segment
removeSegments xs ys = foldr subSegment xs ys
  where
    subSegment :: Segment -> Set Segment -> Set Segment
    subSegment s xs = addSegment (negateSeg s) xs

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

getPair :: IO (Int, Int)
getPair = do
  [a, b] <- readChar8
  return (a, b)

printAns :: CoDomain -> IO ()
printAns = putStrLn . showResult

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

-- solveOne :: Int -> Int -> Int -> [Int] -> Bool
-- solveOne total n m xs = (not (null ks) && (maximum ks) > 2 || even m) && sum ks >= m
--   where ks = filter (>1) $ map (`div` n) xs

getStart :: Segment -> Int
getStart (x, _, _, _) = x

getEnd :: Segment -> Int
getEnd (_, y, _, _) = y

getStartHeight :: Segment -> Int
getStartHeight (_, _, a, _) = a

getEndHeight :: Segment -> Int
getEndHeight (x1, x2, a, b) = a + (x2-x1) * b

getHeight :: Segment -> Int
getHeight s = max (getStartHeight s) (getEndHeight s)

containsPoint :: Int -> (Int, Int) -> Bool
containsPoint x (a,b) = a - b <= x && x <= a + b

getHighest :: Set Segment -> Segment
getHighest xs = maximumBy (comparing getHeight) $ Set.toAscList  xs

getHeightPos :: Segment -> Int
getHeightPos (x1, x2, _, b)
  | b >= 0 = x2
  | otherwise = x1

-- (Height, height of the position)
computeHighPoint :: Set Segment -> (Int, Int)
computeHighPoint xs = (getHeight seg,  getHeightPos seg) where seg = getHighest xs

computeHigh :: Set Segment -> Int
computeHigh = fst . computeHighPoint

-- remove seg, height lower than m
solveOne :: Int -> Int -> Set Segment -> (Int, Int) -> Bool
solveOne hightPoint m merged xs = containsPoint hightPoint xs && (computeHigh $ removeSegments merged $ uncurry toSegments xs) > m

showResult :: [Bool] -> String
showResult xs =  map (bool '1' '0') xs

solve :: Solver
solve (m, xs) = results -- ++ show xs ++ ":" -- ++ show containsPointSegments
  where
        merged = foldr addSegment Set.empty (concatMap (uncurry toSegments) xs)
        hightPoint = snd $ computeHighPoint merged
        containsPointSegments = uncurry toSegments <$> filter (containsPoint hightPoint) xs
        results = solveOne hightPoint m merged <$> xs

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


import Control.Monad
import Data.Maybe
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
    [n] <- getInts
    _ <- C.getLine
    let f j i = intDec j `mappend` charUtf8 ' ' `mappend` intDec (2 * i - 1) `mappend` charUtf8 ' ' `mappend` intDec (2 * i) `mappend` charUtf8 '\n'
        func i = f 1 i `mappend` f 2 i `mappend` f 1 i `mappend` f 2 i `mappend` f 1 i `mappend` f 2 i
        result = mconcat [func i | i <- [1 .. n `div` 2]]
    return $ intDec (3 * n) `mappend` charUtf8 '\n' `mappend` result
  hPutBuilder stdout output

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    _a <- readInts
    let
      n2 = div n 2
    putInts [n2 * 6]
    forM_ [1 .. n2] $ \iv -> replicateM_ 2 $ do
      putInts [1, iv*2 - 1, iv*2]
      putInts [2, iv*2 - 1, iv*2]
      putInts [1, iv*2 - 1, iv*2]

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

fill :: Map.Map (Int, Int) Int -> Int -> Int -> Int -> Int -> Int -> Map.Map (Int, Int) Int
fill m xmax cnt a x y
  | cnt == 1 && not memb = newmap
  | left = if memb then fill m xmax cnt a x (y-1) else fill newmap xmax (cnt-1) a x (y-1)
  | down = if memb then fill m xmax cnt a (x+1) y else fill newmap xmax (cnt-1) a (x+1) y
  | right = if memb then fill m xmax cnt a x (y+1) else fill newmap xmax (cnt-1) a x (y+1)
  | otherwise = error "nowhere to go"
  where memb = Map.member (x, y) m
        left = y > 1 && Map.notMember (x, y-1) m
        right = y < x && Map.notMember (x, y+1) m
        down = x < xmax && Map.notMember (x+1, y) m
        newmap = Map.insert (x, y) a m

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  xs <- readInts :: IO [Int]
  let res = foldl (\m (x, i) -> fill m n x x i i) Map.empty $ zip xs [1..n]
      lines = [zip (repeat i) [1..i] |  i <- [1..n]]
      sol = intercalate "\n" $ map (intercalate " " . map (\k -> show . Map.findWithDefault 0 k $ res)) lines
    in putStrLn sol

main = do
  let t = 1
  replicateM_ t $ solve

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

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

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

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

putInts :: [Int] -> Builder
putInts xs = (mconcat $ intersperse (charUtf8 ' ') $ map intDec xs) `mappend` (charUtf8 '\n')

main :: IO ()
main = do
  [n] <- getInts
  ps <- getInts
  let ps' = scanl' acc ps [1..n-1]
        where acc xs t = filter (/= t) xs
      transform cnt pss
        | cnt > n = []
        | otherwise = reverse (map head as) : transform (cnt + 1) (map tail as ++ bs)
        where (as, bs) = splitAt cnt pss
      output = mconcat $ map putInts $ transform 1 ps'
  hPutBuilder stdout output

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Array((!))
import Control.Monad(replicateM)

import Data.Maybe

solve :: Integer -> [Integer] -> [[Integer]]
solve 1 [1] = [[1]]
solve 1 _ = error "impossile"

solve 2 [1, 2] = [[1], [2, 2]]
solve 2 [2, 1] = [[2], [2, 1]]
solve 2 _ = error "impossible"

solve n diag = [diag !! 0] : fmap (\(i, j) -> (fmap (+1) j)++[i]) (zip (tail diag) solution) where
	solution = solve (n-1) $ fmap (\i->i-1) $ filter (/=1) diag

showR :: [[Integer]] -> String
showR (x:xs) = foldr (\i s->show i ++ " " ++ s) "\n" x ++ showR xs
showR [] = []

main = do
	let t = 1 -- t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		diag <- getLine >>= return . (fmap read) . words :: IO [Integer]
		putStr $ showR $ solve n diag


import qualified Data.Set as S

getChunksSizes :: String -> S.Set Char -> [Int]
getChunksSizes xs set = go xs 0 where
    go [] acc = [acc]
    go (x : xs) acc =
        if S.member x set then acc : go xs 0
        else go xs (acc + 1)

summation :: Int -> Integer
summation n = x*(x + 1) `div` 2 where
    x = toInteger n

getNumSubs :: String -> S.Set Char -> Integer
getNumSubs xs keys = foldl (+) 0 $ map summation (getChunksSizes xs keys)

getMissingKeys :: String -> String ->  S.Set Char
getMissingKeys xs keys = S.difference setXs setKeys where
    setXs = S.fromList xs
    setKeys = S.fromList keys

main =
    getLine >> getLine >>= \xs ->
    concat . words <$> getLine >>= \keys ->
    print $ getNumSubs xs (getMissingKeys xs keys)

import Control.Monad

solve :: String -> [Char] -> [Integer]
solve inp  l =uncurry (:) (foldl f (0,[]) inp )
  where
    f (count,list) char
      |char `elem` l = (count+1,list)
      |otherwise = (0,count:list)

c :: [Integer] -> Integer
c =sum. map (\x -> x*(x+1) `div` 2)

routine :: IO ()
routine = do
  _ <- getLine
  m <- getLine
  l <- (concat.words) <$>getLine
  print $ c $  solve m l

main :: IO ()
main = do
  routine

main :: IO ()
main = getLine >> f <$> input >>= print
  where f (s, d) = solve d s

type Dict = String

input :: IO (String, Dict)
input = (,) <$> getLine <*> fmap (mconcat . words) getLine

nextToken :: Dict -> String -> (String, String)
nextToken dict = span pred . dropUntil pred
  where pred = (`elem` dict)
        dropUntil p = dropWhile $ not . p

solve :: Dict -> String -> Integer
solve _ [] = 0
solve dict s = f (fromIntegral $ length t) + solve dict r
  where (t, r) = nextToken dict s
        f l = (l + 1) * l `div` 2

import Control.Monad

solve :: String -> [Char] -> [Int]
solve inp  l =uncurry (:) (foldl f (0,[]) inp )
  where
    f (count,list) char
      |char `elem` l = (count+1,list)
      |otherwise = (0,count:list)

c :: [Int] -> Int
c =sum. map (\x -> x*(x+1) `div` 2)

routine :: IO ()
routine = do
  _ <- getLine
  m <- getLine
  l <- (concat.words) <$>getLine
  print $ c $  solve m l

main :: IO ()
main = do
  routine

main :: IO ()
main = getLine >> f <$> input >>= print
  where f (s, d) = solve d s

type Dict = String

input :: IO (String, Dict)
input = (,) <$> getLine <*> fmap (mconcat . words) getLine

nextToken :: Dict -> String -> (String, String)
nextToken dict = span pred . dropUntil pred
  where pred = (`elem` dict)
        dropUntil p = dropWhile $ not . p

solve :: Dict -> String -> Int
solve _ [] = 0
solve dict s = f (length t) + solve dict r
  where (t, r) = nextToken dict s
        f l = (l + 1) * l `div` 2

import qualified Data.Set as S

getChunksSizes :: String -> S.Set Char -> [Int]
getChunksSizes xs set = go xs 0 where
    go [] acc = [acc]
    go (x : xs) acc =
        if S.member x set then acc : go xs 0
        else go xs (acc + 1)

summation :: Int -> Int
summation n = n*(n + 1) `div` 2

getNumSubs :: String -> S.Set Char -> Int
getNumSubs xs keys = foldl (+) 0 $ map summation (getChunksSizes xs keys)

getMissingKeys :: String -> String ->  S.Set Char
getMissingKeys xs keys = S.difference setXs setKeys where
    setXs = S.fromList xs
    setKeys = S.fromList keys

main =
    getLine >> getLine >>= \xs ->
    concat . words <$> getLine >>= \keys ->
    print $ getNumSubs xs (getMissingKeys xs keys)


import qualified Data.Map as M
main = interact $ unlines . map unwords . go . lines
go (h:a:n:q) = M.elems . M.foldWithKey f M.empty . M.filter (\(c,t) -> c >= 2) $ calc (M.fromList $ l) (map words q)
   where cr s = map (\x -> ((s,x),(0,0))) [1..99]
         l = (cr "h") ++ (cr "a")
         f k@(tm,p) (_,t) = M.insert t [g tm,show p,show t]
         g s | s == "h" = h
             | True = a
calc m q = foldl upd m q
     where upd x [st,tm,sp,k] = M.adjust f (tm,p) x
               where f (c,t') | c < 2 = (c + ik,t)
                              | True = (c,t')
                     ik | k == "y" = 1
                        | True = 2
                     t = read st
                     p = read sp

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  hName <- getLine
  aName <- getLine
  _n <- getLine
  ttpcs <- sort.parse.words <$> getContents
  case solve hName aName ttpcs of
    [] -> return ()
    res -> putStr $ unlines res

type Time = Int
data Team = H | A deriving (Eq,Ord)
type Player = Int
data Color = Y | R deriving (Eq,Ord)

parse :: [String] -> [(Time,Team,Player,Color)]
parse (time:t:p:c:rest) = (read time, bool H A (t=="h"),read p,bool Y R (c=="y")) : parse rest
parse _ = []

solve :: String -> String -> [(Time,Team,Player,Color)] -> [String]
solve hName aName ttpcs = go [] [] ttpcs
   where
     showTeam H = hName
     showTeam A = aName
     isLive (t0,p0) (_,t,p,_) = t0/=t || p0/=p
     go hps aps ((time,team,player,color):rest)
       | color == R = res : go hps aps (filter (isLive (team,player))rest)
       | team == H, elem player hps = res : go hps aps (filter (isLive(team,player))rest)
       | team == H = go (player:hps) aps rest
       | team == A, elem player aps = res : go hps aps (filter (isLive(team,player))rest)
       | team == A = go hps (player:aps) rest
       | otherwise = undefined
      where
        res = unwords[showTeam team, show player, show time]
     go _ _ _ = []

import Data.Function (on)
import Data.List (foldl', sortBy)
import qualified Data.Map as M

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

solve :: [String] -> [String]
solve (home:away:_:xs) = map format $ sortBy (compare `on` snd) $ M.toList
                       $ M.filter isRedCard $ foldl' go M.empty xs
  where go m x = M.insertWith' f (team, number) (card, read time :: Integer) m
          where [time, team, number, card] = words x
                f (_, t) ("y", _) = ("r", t); f _ p@("r", _) = p; f n _ = n
        format ((team, number), (_, time)) = unwords [ teamName team, number, show time ]
        teamName "h" = home; teamName _ = away
        isRedCard = (=="r") . fst
solve _ = undefined

import Control.Monad
import qualified Data.Map as M
import Data.List (sort)

main :: IO ()
main = do
  home <- getLine
  away <- getLine
  n <- fmap read getLine
  inp <- forM [1..n] $ \_ -> do
           [t, l, m, c] <- fmap words getLine
           return $ if l == "h" then (read t, home, 0, read m, head c)
                  else (read t, away, 1, read m, head c)
  solve (sort inp)

solve :: [(Int, String, Int, Int, Char)] -> IO ()
solve f = foldl g (return M.empty) f >> return ()
  where
    g :: IO (M.Map (Int, Int) Int) -> (Int, String, Int, Int, Char) -> IO (M.Map (Int, Int) Int)
    g m (t, tn, b, pn, cc) = m >>= \ma -> case M.lookup (b, pn) ma of
                                         Nothing -> if cc == 'r'
                                                    then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                         >> return (M.insert (b, pn) 2 ma)
                                                    else return (M.insert (b, pn) 1 ma)
                                         Just x -> if cc == 'r'
                                                   then if x == 1
                                                        then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                             >> return (M.insert (b, pn) 2 ma)
                                                        else return ma
                                                   else if x == 1
                                                        then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                             >> return (M.insert (b, pn) 2 ma)
                                                        else return ma

import Data.List (foldl', sortBy)
import qualified Data.Map as M
import Data.Function (on)

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

solve :: [String] -> [String]
solve (home:away:_:xs) = map format $ sortBy (compare `on` snd) $ M.toList
                       $ M.filter ((=="r") . fst) $ foldl' go M.empty xs
  where go m x = M.insertWith' f (team, number) (card, read time :: Integer) m
          where [time, team, number, card] = words x
                f (_, t) ("y", _) = ("r", t)
                f _ p@("r", _) = p
                f n _ = n
        format ((team, number), (_, time)) = unwords [ if team == "h" then home else away, number, show time ]
solve _ = undefined

import Data.List (foldl', sortBy)
import qualified Data.Map as M
import Data.Function (on)

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

solve :: [String] -> [String]
solve (home:away:_:xs) = map format $ sortBy (compare `on` snd) $ M.toList
                       $ M.filter ((=="r") . fst) $ foldl' go M.empty xs
  where go m x = M.insertWith' f (team, number) (card, read time :: Integer) m
          where [time, team, number, card] = words x
                f (_, t) ("y", _) = ("r", t)
                f n _ = n
        format ((team, number), (_, time)) = unwords [ if team == "h" then home else away, number, show time ]
solve _ = undefined

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  hName <- getLine
  aName <- getLine
  _n <- getLine
  ttpcs <- parse.words <$> getContents
  case solve hName aName ttpcs of
    [] -> return ()
    res -> putStr $ unlines res

type Time = Int
data Team = H | A deriving (Eq,Ord)
type Player = Int
data Color = Y | R deriving (Eq,Ord)

parse :: [String] -> [(Time,Team,Player,Color)]
parse (time:t:p:c:rest) = (read time, bool H A (t=="h"),read p,bool Y R (c=="y")) : parse rest
parse _ = []

solve :: String -> String -> [(Time,Team,Player,Color)] -> [String]
solve hName aName ttpcs = go [] [] ttpcs
   where
     showTeam H = hName
     showTeam A = aName
     go hps aps ((time,team,player,color):rest)
       | color == R = res : go hps aps rest
       | team == H, elem player hps = res : go hps aps rest
       | team == H = go (player:hps) aps rest
       | team == A, elem player aps = res : go hps aps rest
       | team == A = go hps (player:aps) rest
       | otherwise = undefined
      where
        res = unwords[showTeam team, show player, show time]
     go _ _ _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  hName <- getLine
  aName <- getLine
  _n <- getLine
  ttpcs <- sort.parse.words <$> getContents
  case solve hName aName ttpcs of
    [] -> return ()
    res -> putStr $ unlines res

type Time = Int
data Team = H | A deriving (Eq,Ord)
type Player = Int
data Color = Y | R deriving (Eq,Ord)

parse :: [String] -> [(Time,Team,Player,Color)]
parse (time:t:p:c:rest) = (read time, bool H A (t=="h"),read p,bool Y R (c=="y")) : parse rest
parse _ = []

solve :: String -> String -> [(Time,Team,Player,Color)] -> [String]
solve hName aName ttpcs = go [] [] ttpcs
   where
     showTeam H = hName
     showTeam A = aName
     f (_,_,p,_) = p
     go hps aps ((time,team,player,color):rest)
       | color == R = res : go hps aps (filter ((player/=).f)rest)
       | team == H, elem player hps = res : go hps aps (filter ((player/=).f)rest)
       | team == H = go (player:hps) aps rest
       | team == A, elem player aps = res : go hps aps (filter ((player/=).f)rest)
       | team == A = go hps (player:aps) rest
       | otherwise = undefined
      where
        res = unwords[showTeam team, show player, show time]
     go _ _ _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  hName <- getLine
  aName <- getLine
  _n <- getLine
  getContents>>=putStr.init.unlines.solve hName aName.sort.parse.words

type Time = Int
data Team = H | A deriving (Eq,Ord)
type Player = Int
data Color = Y | R deriving (Eq,Ord)

parse :: [String] -> [(Time,Team,Player,Color)]
parse (time:t:p:c:rest) = (read time, bool H A (t=="h"),read p,bool Y R (c=="y")) : parse rest
parse _ = []

solve :: String -> String -> [(Time,Team,Player,Color)] -> [String]
solve hName aName ttpcs = go [] [] ttpcs
   where
     showTeam H = hName
     showTeam A = aName
     go hps aps ((time,team,player,color):rest)
       | color == R = res : go hps aps rest
       | team == H, elem player hps = res : go hps aps rest
       | team == H = go (player:hps) aps rest
       | team == A, elem player aps = res : go hps aps rest
       | team == A = go hps (player:aps) rest
       | otherwise = undefined
      where
        res = unwords[showTeam team, show player, show time]
     go _ _ _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  hName <- getLine
  aName <- getLine
  _n <- getLine
  getContents>>=putStr.unlines.solve  hName aName.sort.parse.words

type Time = Int
data Team = H | A deriving (Eq,Ord)
type Player = Int
data Color = Y | R deriving (Eq,Ord)

parse :: [String] -> [(Time,Team,Player,Color)]
parse (time:t:p:c:rest) = (read time, bool H A (t=="h"),read p,bool Y R (c=="y")) : parse rest
parse _ = []

solve :: String -> String -> [(Time,Team,Player,Color)] -> [String]
solve hName aName ttpcs = go [] [] ttpcs
   where
     showTeam H = hName
     showTeam A = aName
     go hps aps ((time,team,player,color):rest)
       | color == R = res : go hps aps rest
       | team == H, elem player hps = res : go hps aps rest
       | team == H = go (player:hps) aps rest
       | team == A, elem player aps = res : go hps aps rest
       | team == A = go hps (player:aps) rest
       | otherwise = undefined
      where
        res = unwords[showTeam team, show player, show time]
     go _ _ _ = []

import Control.Monad
import qualified Data.Map as M
import Data.List (sort)

main :: IO ()
main = do
  home <- getLine
  away <- getLine
  n <- fmap read getLine
  inp <- forM [1..n] $ \_ -> do
           [t, l, m, c] <- fmap words getLine
           return $ if l == "h" then (read t, home, read m, head c)
                  else (read t, away, read m, head c)
  solve (sort inp)

solve :: [(Int, String, Int, Char)] -> IO ()
solve f = foldl g (return M.empty) f >> return ()
  where
    g :: IO (M.Map Int Int) -> (Int, String, Int, Char) -> IO (M.Map Int Int)
    g m (t, tn, pn, cc) = m >>= \ma -> case M.lookup pn ma of
                                         Nothing -> if cc == 'r'
                                                    then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                         >> return (M.insert pn 2 ma)
                                                    else return (M.insert pn 1 ma)
                                         Just x -> if cc == 'r'
                                                   then if x == 1
                                                        then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                             >> return (M.insert pn 2 ma)
                                                        else return ma
                                                   else if x == 1
                                                        then putStrLn (tn ++ " " ++ show pn ++ " " ++ show t)
                                                             >> return (M.insert pn 2 ma)
                                                        else return ma


import Control.Monad
import Data.Maybe
import Data.Char
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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- filter (not . isSpace) . C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      getIndex (Node Nothing _ _) = 0
      getIndex (Node (Just (i, _)) _ _) = i
      step node@(Node (Just (idx, prev)) [] _) _ = Left (idx - getIndex prev)
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

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

forFoldM_ v s f = foldM_ f v s

suffixArray :: String -> UArray Int Int
suffixArray s = goSa 1 saInit rInit
    where
        n = length s
        saInit = listArray (0,n-1) [0..]
        rInit = listArray (0,n-1) (map ord s)

        goSa k sa r
            | k >= n = sa
            | otherwise =
                let
                    sa0 = csort k sa r
                    sa1 = csort 0 sa0 r
                    vs = [(r ! (sa1 ! i), getR ((sa1 ! i) + k)) | i <- [0..n-1]]
                    newR = zip (elems sa1) $ scanl (\s (a,b) -> if a == b then s else s + 1) 0 $ zip vs (tail vs)
                in
                    goSa (2*k) sa1 (array (0,n-1) newR)

         where
            getR t = if t < n then r ! t else 0

            csort :: Int -> UArray Int Int -> UArray Int Int -> UArray Int Int
            csort k sa r = runST $ do
                let cl = max 255 n
                c <- newArray (0, cl-1) 0 :: ST s (STUArray s Int Int)
                forM_ [0..n-1] $ \i -> do
                    modifyArray (+1) c (getR (i + k))
                forFoldM_ 0 [0..cl-1] $ \s i -> do
                    t <- readArray c i
                    writeArray c i s
                    return $ s + t

                rr <- forM [0..n-1] $ \i -> do
                    let sai = sa ! i
                        j = getR $ sai + k
                    t <- readArray c j
                    writeArray c j $ t + 1
                    return (t, sai)
                return $ array (0,n-1) rr

zFunction :: String -> UArray Int Int
zFunction s0 = runSTUArray $ do
    let n = length s0
        s = listArray (0,n-1) s0 :: UArray Int Char
    z <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int)
    forFoldM_ (0,0) [1..n-1] $ \(l,r) i -> do
        when (i <= r) $ readArray z (i-l) >>= \v -> writeArray z i $ min (r-i+1) v
        let loop = do
            zi <- readArray z i
            when (i + zi < n && (s ! zi) == (s ! (i + zi))) $ do
                writeArray z i (zi+1)
                loop
        loop
        zi <- readArray z i
        return $ if i + zi - 1 > r then (i,i+zi-1) else (l,r)
    return z

solve :: String -> Int -> String
solve s0 k =
    let
        s = s0 ++ "~"
        n = length s
        z = zFunction s
        a = listArray (0,n-1) s :: UArray Int Char
        l = foldr1 op [1..]
        op i j = if (a ! (i + (z ! i))) > (a ! (z ! i)) then i else j
    in
        take k $ cycle (take l s0)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k

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

forFoldM_ v s f = foldM_ f v s

suffixArray :: String -> UArray Int Int
suffixArray s = goSa 1 saInit rInit
    where
        n = length s
        saInit = listArray (0,n-1) [0..]
        rInit = listArray (0,n-1) (map ord s)

        goSa k sa r
            | k >= n = sa
            | otherwise =
                let
                    sa0 = csort k sa r
                    sa1 = csort 0 sa0 r
                    vs = [(r ! (sa1 ! i), getR ((sa1 ! i) + k)) | i <- [0..n-1]]
                    newR = zip (elems sa1) $ scanl (\s (a,b) -> if a == b then s else s + 1) 0 $ zip vs (tail vs)
                in
                    goSa (2*k) sa1 (array (0,n-1) newR)

         where
            getR t = if t < n then r ! t else 0

            csort :: Int -> UArray Int Int -> UArray Int Int -> UArray Int Int
            csort k sa r = runST $ do
                let cl = max 255 n
                c <- newArray (0, cl-1) 0 :: ST s (STUArray s Int Int)
                forM_ [0..n-1] $ \i -> do
                    modifyArray (+1) c (getR (i + k))
                forFoldM_ 0 [0..cl-1] $ \s i -> do
                    t <- readArray c i
                    writeArray c i s
                    return $ s + t

                rr <- forM [0..n-1] $ \i -> do
                    let sai = sa ! i
                        j = getR $ sai + k
                    t <- readArray c j
                    writeArray c j $ t + 1
                    return (t, sai)
                return $ array (0,n-1) rr

zFunction :: String -> UArray Int Int
zFunction s0 = runSTUArray $ do
    let n = length s0
        s = listArray (0,n-1) s0 :: UArray Int Char
    z <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int)
    forFoldM_ (0,0) [1..n-1] $ \(l,r) i -> do
        when (i <= r) $ readArray z (i-1) >>= \v -> writeArray z i $ min (r-i+1) v
        let loop = do
            zi <- readArray z i
            when (i + zi < n && (s ! zi) == (s ! (i + zi))) $ do
                writeArray z i (zi+1)
                loop
        loop
        zi <- readArray z i
        return $ if i + zi - 1 > r then (i,i+zi-1) else (l,r)
    return z

solve :: String -> Int -> String
solve s0 k =
    let
        s = s0 ++ "~"
        n = length s
        z = zFunction s
        a = listArray (0,n-1) s :: UArray Int Char
        l = foldr1 op [1..]
        op i j = if (a ! (i + (z ! i))) > (a ! (z ! i)) then i else j
    in
        take k $ cycle (take l s0)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k


{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S

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

parse (r:a:b:rabs) = [(r,c)|c<-[a..b]] ++ parse rabs
parse _ = []

main = do
  [x0,y0,x1,y1] <- map read.words <$> getLine ::IO [Int]
  _ <- getLine
  gr <- parse.map readInt.B.words <$> B.getContents :: IO [(Int,Int)]
  print $ bfs (S.fromList $ (x1,y1):gr) (x0,y0) (x1,y1)

type Vertex = (Int,Int)
type Cost = Int

bfs :: S.Set Vertex -> Vertex -> Vertex -> Cost
bfs gr start goal = go (Q [start] []) $ M.singleton start 0
   where
     neighbors (x,y) = filter (`S.member`gr) [(x+1,y),(x+1,y+1),(x,y+1),(x-1,y+1),(x-1,y),(x-1,y-1),(x,y-1),(x+1,y-1)]
     go queue dist
       | isEmpty queue = -1
       | q == goal = fromJust $ M.lookup goal dist
       | otherwise = go (foldr enq rest nexts) $! foldl' (\m k->M.insert k (dq+1) m) dist nexts
      where
        (q,rest) = deq queue
        dq = fromJust $ M.lookup q dist
        nexts = filter (isNothing.(`M.lookup`dist)) $ neighbors q

data Queue = Q [Vertex] [Vertex]

isEmpty (Q [] []) = True
isEmpty _ = False

enq x (Q f r) = Q f (x:r)

deq (Q (f:fs) rs) = (f,Q fs rs)
deq (Q _ rs) = deq (Q (reverse rs) [])

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

gao s@(sx,sy) t@(tx,ty) e =
  if M.member s d && M.member t d
    then fromJust $ M.lookup t $ bfs [s] (M.insert s 0 d)
    else -1
  where
    d = M.fromList [((i, j), -1) | [i, l, r] <- e, j <- [l .. r]]
    bfs [] d = d
    bfs (v@(x,y):vs) d = bfs (vs ++ w) $ foldl (\i k -> M.insert k t i) d w
      where
        w = [(i, j) |
            i <- [x - 1 .. x + 1],
            j <- [y - 1 .. y + 1],
            M.lookup (i, j) d == Just (-1)]
        t = succ $ fromJust $ M.lookup v d

main = do
  [x0, y0, x1, y1] <- getArray
  [n] <- getArray
  e <- replicateM n getArray
  print $ gao (x0, y0) (x1, y1) e
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

{-# OPTIONS_GHC -O2  -funbox-strict-fields #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import Data.STRef

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

parse (r:a:b:rabs) = [(r,c)|c<-[a..b]] ++ parse rabs
parse _ = []

main = do
  [x0,y0,x1,y1] <- map read.words <$> getLine ::IO [Int]
  _ <- getLine
  gr <- parse.map readInt.B.words <$> B.getContents :: IO [(Int,Int)]
  print $ dijkstra ((x0,y0):(x1,y1):gr) (x0,y0) (x1,y1)

type Vertex = (Int,Int)
type Cost = Int
type Graph = S.Set (Int,Int)

inf :: Cost
inf = 1000000000

neighbors (x,y) = [(x+1,y),(x+1,y+1),(x,y+1),(x-1,y+1),(x-1,y),(x-1,y-1),(x,y-1),(x+1,y-1)]

dijkstra gr start goal = runST $ do
  dist <- newSTRef M.empty :: ST s (STRef  s (M.Map Vertex Cost))
  unvisited <-  newSTRef (S.fromList gr) :: ST s (STRef s (S.Set Vertex))
  let get v = do
         m <- readSTRef dist
         return $! maybe inf id $! M.lookup v m
      put v d = do
         m <- readSTRef dist
         writeSTRef dist $! M.insertWith min v d m
      isUnvisited v = do
         s <- readSTRef unvisited
         return $! S.member v s
      visit v =  do
         s <- readSTRef unvisited
         writeSTRef unvisited $! S.delete v s

  let go heap
        | isEmpty heap = do ans <- get goal; if ans==inf then return $ -1 else return ans
        | otherwise = do
            let (v,vcost,rest) = deleteFindMin heap
            dv <- get v
            visit v
            if vcost > dv
               then go rest
               else do
                 nextheap <- fmap(foldr ins rest.catMaybes).forM (neighbors v) $ \nv -> do
                   unvisited <- isUnvisited nv
                   if unvisited
                      then do
                        let newdnv = vcost + 1
                        olddnv <- get nv
                        if newdnv < olddnv
                         then do
                           put nv newdnv
                           return $ Just (nv,newdnv)
                         else return Nothing
                      else return Nothing
                 visit v
                 go nextheap
  put start 0
  visit start
  go $ ins (start,0) Empty

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

isEmpty :: Heap -> Bool
isEmpty Empty = True
isEmpty _ = False

ins :: (Vertex, Cost) -> Heap -> Heap
ins (v,cost) h = merge (Fork v cost []) h

deleteFindMin :: Heap -> (Vertex, Cost, Heap)
deleteFindMin (Fork v cost hs) = (v, cost, mergePairs hs)

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

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


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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

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

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

{- aux -}
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

{- solution -}

type SolutionState = (IM.IntMap (Int, Int64))

mergeX :: (Int, Int64) -> (Int, Int64) -> (Int, Int64)
mergeX (cnt1, s1) (cnt2, s2) = (cnt1 + cnt2, s1 + s2)

preSolve :: Int -> [Int] -> SolutionState
preSolve n as = L.foldr (\x mp -> IM.insertWith mergeX (x `mod` 2) (1, fromIntegral x) mp) emptyState as
    where
        emptyState :: SolutionState
        emptyState = IM.fromList [(0, (0, 0)), (1, (0, 0))]

query :: (Monad m) => Int -> Int -> MS.StateT SolutionState m Int64
query mod2 x = do
    (cnt, s) <- MS.gets (IM.! mod2)

    let newMod2 = (mod2 + x) `mod` 2
    MS.modify (IM.insertWith mergeX mod2 (-cnt, -s))
    MS.modify (IM.insertWith mergeX newMod2 (cnt, s))
    MS.modify (IM.insertWith mergeX newMod2 (0, fromIntegral $ x * cnt))

    tracingM "mod2" mod2
    tracingM "x" x

    (_, s0) <- MS.gets (IM.! 0)
    (_, s1) <- MS.gets (IM.! 1)
    return $ s0 + s1

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, q] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let state = preSolve n as
        flip MS.evalStateT state . M.replicateM_ q $ do
            [mod2, x] <- MT.lift $ B8.getLine <&> readIntB8s
            tracingM "mod2" mod2
            tracingM "x" x
            answer <- query mod2 x
            MT.lift $ printf "%lld\n" answer

{-# LANGUAGE RecordWildCards #-}
module Main where

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

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

data Values = Values
  { valuesSum :: Int
  , numberEven :: Int
  , numberOdd :: Int
  }

data Query = Query
  { onEven :: Bool
  , summand :: Int
  }

toValues vs = Values
  { valuesSum = sum vs
  , numberEven = length $ filter even vs
  , numberOdd = length $ filter odd vs
  }

processQuery :: Values -> Query -> Values
processQuery Values{..} Query{..}
  | onEven      = Values{ valuesSum = valuesSum + summand * numberEven
                        , numberEven = if even summand then numberEven else 0
                        , numberOdd = if even summand then numberOdd else numberEven + numberOdd
                        }
  | otherwise   = Values{ valuesSum = valuesSum + summand * numberOdd
                        , numberEven = if even summand then numberEven else numberEven + numberOdd
                        , numberOdd = if even summand then numberOdd else 0
                        }

processQueries :: Values -> [Query] -> [Values]
processQueries vs qs = drop 1 $ scanl processQuery vs qs

parseQuery :: IO Query
parseQuery = do
  [e, s] <- map parseInt . B.words <$> B.getLine
  pure $ Query (e == 0) s

handleProblem :: IO ()
handleProblem = do
  [n, q] <- map parseInt . B.words <$> B.getLine
  vs <- toValues . map parseInt . B.words <$> B.getLine
  qs <- replicateM q parseQuery
  putStrLn $ intercalate "\n" $ map (show . valuesSum) $ processQueries vs qs

main :: IO ()
main = do
  numberProblems <- read <$> getLine
  replicateM_ numberProblems handleProblem

parseInt :: B.ByteString -> Int
parseInt = maybe 0 fst . B.readInt


module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Data.Word (Word64)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Word64
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Word64] -> [(Int, Word64)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Word64)] -> [Word64]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (fromIntegral $ pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((fromIntegral $ pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Word64 -> Word64 -> Word64
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Word64] -> Word64
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Word64) -> Word64 -> Word64 -> Word64
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

nextWord64 :: Tokenizer Word64
nextWord64 = state $ \(s:ss) -> (fromIntegral s, ss)

go :: Tokenizer Word64
go = do
  n <-  nextInt
  ps <- replicateM n nextWord64
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input

module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Integer
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Integer] -> [(Int, Integer)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Integer)] -> [Integer]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (fromIntegral $ pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((fromIntegral $ pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Integer -> Integer -> Integer
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Integer] -> Integer
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Integer) -> Integer -> Integer -> Integer
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

nextInteger :: Tokenizer Integer
nextInteger = state $ \(s:ss) -> (fromIntegral s, ss)

go :: Tokenizer Integer
go = do
  n <-  nextInt
  ps <- replicateM n nextInteger
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input

module Main where

import Control.Monad
import Control.Monad.State
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as L

modulo, moduloM1 :: Int
modulo = 1000000000 + 7
moduloM1 = modulo - 1

getLambda :: [Int] -> [(Int, Int)]
getLambda = map toPair . group . sort
    where toPair ps = (length ps, head ps)

prefixModulo, suffixModulo :: [(Int, Int)] -> [Int]
prefixModulo = scanl update 1
    where update pl (pr, _) = (pl * (pr + 1)) `mod` moduloM1
suffixModulo = scanr update 1
    where update (pl, _) pr = ((pl + 1) * pr) `mod` moduloM1

modPow, modMul :: Int -> Int -> Int
modPow a 0 = 1
modPow a n | even n    = c
           | otherwise = a `modMul` c
           where b = a `modPow` (n `div` 2)
                 c = b `modMul` b
modMul a b = (a * b) `mod` modulo

solve :: [Int] -> Int
solve ps = foldr modMul 1 $ zipWith3 calc ls pm sm
    where ls = getLambda ps
          pm = prefixModulo ls
          sm = tail $ suffixModulo ls

          calc :: (Int, Int) -> Int -> Int -> Int
          calc (l, p) pref suff = foldr modMul 1 powers
              where s = (pref * suff) `mod` moduloM1
                    m = modPow p s
                    powers = take (l + 1) $ iterate (`modMul` m) 1

type Tokenizer = State [Int]

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

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> (s, ss)

go :: Tokenizer Int
go = do
  n <-  nextInt
  ps <- replicateM n nextInt
  return $ solve ps

main :: IO ()
main = do
  input <- liftM (map parseInt . L.words) L.getContents
  print $ evalState go input


import Array
import Data.Set
import Monad (liftM)
import Prelude hiding (filter)

parseFirstLine :: String -> (Int, Int, Char)
parseFirstLine line  =  case words line of
    [w1, w2, w3]  ->  (read w1, read w2, head w3)

parsePlane :: (Int, Int) -> [String] -> Array (Int, Int) Char
parsePlane (n, m) lines  =  accumArray (flip const) '.' ((0, 0), (n+1, m+1))
    [((i,j), lines !! (i-1) !! (j-1)) | i <- [1..n], j <- [1..m]]

solve :: (Int, Int) -> Char -> Array (Int, Int) Char -> Int
solve (n, m) c array  =  size . fromList $ list
  where
    list  =  [array ! (i, j) | i <- [1..n], j <- [1..m],
        array ! (i,j) /= '.',
        array ! (i,j) /= c,
        any (\(di, dj) -> array ! (i+di,j+dj) == c) [(0,1),(1,0),(0,-1),(-1,0)]]

main :: IO ()
main  =  do
    (n, m, c)  <-  liftM parseFirstLine getLine
    plane  <-  liftM (parsePlane (n, m) . take n . lines) getContents
    print $ solve (n, m) c plane

import Data.Char
import Data.List
import Data.Array.Unboxed
main = do
    [n', m', l'] <- words `fmap` getLine
    let color = head l'
        [n, m] = map read [n', m']
    строки <- mapM (\_ -> (\s' -> let s = take m s' in (any (==color) s, s))
                `fmap` getLine) [1..n]
    let строкиБосса = map fst $ filter snd $ zip [1..] $ map fst строки
        матр = listArray ((1,1),(n, m)) $ concat $ map snd строки :: UArray (Int, Int) Char
        (минХ, максХ) = (minimum строкиБосса, maximum строкиБосса)
        (минУ, максУ) = (minimum a, maximum a) where
            a = filter (\i->(==color) $ (матр!(минХ, i))) [1..m]
        allx = [минХ..максХ]
        ally = [минУ..максУ]
        all = (if минХ > 1  then [(минХ  - 1, i) | i <- ally] else []) ++
              (if максХ < n then [(максХ + 1, i) | i <- ally] else []) ++
              (if минУ > 1  then [(i, минУ  - 1) | i <- allx] else []) ++
              (if максУ < m then [(i, максУ + 1) | i <- allx] else [])
        границы = map (матр!) all
    putStrLn $ show $ length $ nub $ filter isUpper границы

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

count :: Array (Int, Int) Char -> Char -> String
count a c = show . length . group . sort $ do
      let b = bounds a
      (x, y) <- range b
      guard $ a ! (x, y) == c
      idx' <- [(x+1, y), (x-1, y), (x, y-1), (x, y+1)]
      guard $ inRange b idx'
      let c' = a ! idx'
      guard $ c' /= '.' && c' /= c
      return c'

solve :: [String] -> [String]
solve = fmap return $ do
      [nn, mm, cc] <- words . head
      let n = read nn; m = read mm; c = head cc
      xs <- concat . take n . tail
      let a = listArray ((1,1), (n,m)) xs
      return $ count a c

main = interact $ unlines . solve . lines

module Main where

import Data.Array.IArray (listArray, (!), bounds, indices)
import Data.Array.Unboxed (UArray)
import Data.List (sort, group)
import Data.Ix (inRange)
import Control.Monad (replicateM)

type Grid = UArray (Int, Int) Char

solve :: Grid -> Char -> Int
solve gr c = count . filter isViceTable $ concatMap around tablePos
  where
    tablePos = filter (\i -> gr ! i == c) (indices gr)
    isViceTable cc = cc /= c && cc /= '.'
    count = length . group . sort
    around (x, y) = map (gr !) $ filter (inRange $ bounds gr) [ (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) ]

getGrid :: (Int, Int) -> IO Grid
getGrid (n, m) = do
  lines <- replicateM n getLine
  pure $ listArray ((1,1), (n, m)) (concat lines)

main :: IO ()
main = do
  [n, m, c] <- words <$> getLine
  grid <- getGrid (read n, read m)
  print $ solve grid (head c)

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

count :: Array (Int, Int) Char -> Char -> String
count a c = show . length . group . sort $ do
  let b = bounds a
  idx@(y, x) <- range b
  guard $ a ! idx == c
  idx' <- [(y + 1, x), (y - 1,x), (y, x + 1), (y, x - 1)]
  guard $ b `inRange` idx'
  let c' = a ! idx'
  guard $ c' /= '.'
  guard $ c' /= c
  return c'

solve :: [String] -> [String]
solve = fmap return $ do
  [as, bs, cs] <- words . head
  let n = read as ; m = read bs ; c = head cs
  xs <- concat . take n . drop 1
  let a = listArray ((1, 1), (n, m)) xs
  return $ count a c

main = interact $ unlines . solve . lines

module Main where

import Control.Monad
import Data.Array.Unboxed
import Data.Ix
import Data.List
import qualified Data.Set as Set

main = do
    (n, m, ch) <- do
        [n, m, ch] <- words `liftM` getLine
        return (read n, read m, head ch)

    board <- ( listArray ((1,1), (n,m)) . join ) `liftM` replicateM n getLine :: IO (UArray (Int,Int) Char)

    let set = foldl' (\set (r,c) ->
                foldl' (\set (r1,c1,r2,c2) ->
                        let put r1 c1 r2 c2 set =
                                if board ! (r1,c1) == ch
                                    then Set.insert ( board ! (r2,c2) ) set
                                    else set
                        in if valid r1 c1 && valid r2 c2
                            then put r1 c1 r2 c2 $ put r2 c2 r1 c1 set
                            else set
                    ) set [(r,c,r,c+1),(r,c,r+1,c)]
            ) Set.empty $ range ((1,1),(n,m))
        set' = Set.delete '.' $ Set.delete ch set
        valid r c = 1 <= r && r <= n && 1 <= c && c <= m

    --putStrLn $ show board
    --putStrLn $ show set
    putStrLn $ show $ Set.size set'

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

type Room = Array (Int, Int) Color
type Color = Char

countDepties :: Color -> Room -> Int -> Int -> Int
countDepties c room mx my = length $ adjacentTo c room mx my

adjacentTo :: Color -> Room -> Int -> Int -> [Color]
adjacentTo c m mx my = nub $ concatMap f [(x, y) | x <- [0..mx], y <- [0..my]]
  where
    f (x, y) | m ! (x, y) /= c = []
             | otherwise = filter (\d -> d /='.' && d /= c) $ map (m !) $
                up ++ down ++ left ++ right
      where
        up = if y > 0 then [(x, y - 1)] else []
        down = if y < my then [(x, y + 1)] else []
        left = if x > 0 then [(x - 1, y)] else []
        right = if x < mx then [(x + 1, y)] else []

main = do
    n':m':c':_ <- words <$> getLine
    let n = read n' - 1
        m = read m' - 1
        c = head c'
    is <- fmap concat $ forM [0..n] $ \y -> do
            s <- getLine :: IO [Char]
            return $ zip [(x, y) | x <- [0..m]] s
    let arr = array ((0, 0), (m, n)) is
    print $ countDepties c arr m n

import Data.Set (Set, (\\))
import qualified Data.Set as Set
import Control.Monad
import Data.Array.IArray

neighbors ::  Array (Int, Int) Char -> (Int, Int) -> [(Int, Int)]
neighbors arr (r, c) = let try = [(r+1, c), (r-1, c), (r, c+1), (r, c-1)] in
  filter (inRange $ bounds arr) try

solve :: Array (Int, Int) Char -> Char -> Int
solve arr boss = Set.size . (\\ Set.fromList ['.', boss]) . Set.fromList . map (arr!) . concatMap (neighbors arr) . filter ((== boss) . (arr !)) . range $ bounds arr

main = do
  [r, _, color] <- words <$> getLine
  let numRows = read r
  grid <- replicateM numRows getLine
  let arr = listArray ((0, 0), (pred numRows, pred . length $ head grid)) $ join grid

  print $ solve arr (head color)
  return ()

module Main where

import Control.Monad
import Data.Array.Unboxed
import Data.Ix
import Data.List
import qualified Data.Set as Set

main = do
    (n, m, ch) <- do
        [n, m, ch] <- words `liftM` getLine
        return (read n, read m, head ch)

    board <- ( listArray ((1,1), (n,m)) . join ) `liftM` replicateM n getLine :: IO (UArray (Int,Int) Char)

    let set = foldl' (\set (r,c) ->
                foldl' (\set (r1,c1,r2,c2) ->
                        let put r1 c1 r2 c2 set =
                                if board ! (r1,c1) == ch
                                    then Set.insert ( board ! (r2,c2) ) set
                                    else set
                        in put r1 c1 r2 c2 $ put r2 c2 r1 c1 set
                    ) set [(r-1,c-1,r-1,c)
                    ,(r-1,c,r,c)
                    ,(r,c,r,c-1)
                    ,(r,c-1,r-1,c-1)
                    ]
            ) Set.empty $ range ((2,2),(n,m))
        set' = Set.delete '.' $ Set.delete ch set

    --putStrLn $ show board
    --putStrLn $ show set
    putStrLn $ show $ Set.size set'

import Data.Char
import Data.List
import Data.Array.Unboxed
main = do
    [n', m', l'] <- words `fmap` getLine
    let color = head l'
        [n, m] = map read [n', m']
    строки <- mapM (\_ -> (\s' -> let s = take m s' in (any (==color) s, s))
                `fmap` getLine) [1..n]
    let строкиБосса = map fst $ filter snd $ zip [1..] $ map fst строки
        матр = listArray ((1,1),(n, m)) $ concat $ map snd строки :: UArray (Int, Int) Char
        (минХ, максХ) = (minimum строкиБосса, maximum строкиБосса)
        (минУ, максУ) = (minimum a, maximum a) where
            a = filter (\i->(==color) $ (матр!(минХ, i))) [1..m]
        allx = [минХ..максХ]
        ally = [минУ..максУ]
        all = (if минХ > 1  then [(минХ  - 1, i) | i <- ally] else []) ++
              (if максХ < n then [(максХ + 1, i) | i <- ally] else []) ++
              (if минУ < 1  then [(i, минУ  - 1) | i <- allx] else []) ++
              (if максУ < m then [(i, максУ + 1) | i <- allx] else [])
        границы = map (матр!) all
    putStrLn $ show $ length $ nub $ filter isUpper границы

module Main where

import Data.Array.IArray (listArray, (!), bounds, indices)
import Data.Array.Unboxed (UArray)
import Data.List (sort, group)
import Data.Ix (inRange)

type Grid = UArray (Int, Int) Char

solve :: Grid -> Char -> Int
solve gr c = count . filter isViceTable $ concatMap around tablePos
  where
    tablePos = filter (\i -> gr ! i == c) (indices gr)
    isViceTable cc = cc /= c && cc /= '.'
    count = length . group . sort
    around (x, y) = map (gr !) $ filter (inRange $ bounds gr) [ (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) ]

main :: IO ()
main = do
  [n, m, c] <- words <$> getLine
  grid <- listArray ((1, 1), (read n, read m)) <$> getContents :: IO Grid
  print $ solve grid (head c)


--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 qualified Data.Array.Unboxed as UA

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 (C.length ans) <> char7 '\n' <>  byteString ans <> char7 '\n'
  where
    b = take n a
    x = UA.listArray (1, n) b :: UA.UArray Int Int
    loop i j last r
      | i > j = r
      | null l = r
      | d == 'L' = loop (succ i) j v (d:r)
      | d == 'R' = loop i (pred j) v (d:r)
      where
        xi = x UA.! i
        xj = x UA.! j
        l = filter ( (last <  ) . fst) [(xi, 'L'), (xj, 'R')]
        (v, d) = minimum l
    ans = C.reverse $ C.pack $ loop 1 n minBound []

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

import qualified Data.Sequence as S
import Data.Maybe
import Data.Monoid

sHead :: S.Seq a -> Maybe a
sHead s =case S.viewl s of
	((S.:<) n _) -> Just n
	_-> Nothing

sLast :: S.Seq a -> Maybe a
sLast s =case S.viewr s of
	((S.:>) _ n ) -> Just n
	_-> Nothing

sTail :: S.Seq a -> S.Seq a
sTail s = case S.viewl s of
	((S.:<) _ n) -> n
	_ -> S.empty

sInit :: S.Seq a -> S.Seq a
sInit s = case S.viewr s of
	((S.:>) n _) -> n
	_ -> S.empty

sHeadUnsafe :: S.Seq a ->  a
sHeadUnsafe s = fromMaybe undefined $ sHead s

sLastUnsafe :: S.Seq a ->  a
sLastUnsafe s = fromMaybe undefined $ sLast s

type Status a = (a,[Char])
type Situation a = (Status a,S.Seq a)

step :: Ord a => Situation a -> Either ([Char]) (Situation a)
step ((curr,directions),S.Empty) = Left directions
step ((curr,directions),seq)
	|curr < seqHead && curr < seqLast =
	if seqHead <= seqLast
	then
		l
	else
		r
	|curr < seqHead = l
	|curr < seqLast = r
	|otherwise = Left directions
	where
		seqHead= sHeadUnsafe seq
		seqLast= sLastUnsafe seq
		l = Right ((seqHead, ('L': directions)), sTail seq)
		r = Right ((seqLast, ('R':directions) ), sInit seq)

steps ::Ord a => Situation a -> [Char]
steps sit =
	case step sit of
		Left dl -> reverse dl
		Right s -> steps s

main = do
	n <- getLine
	l <- fmap ((map read).words) getLine
	let sol = steps $ ((0,""),S.fromList l)
	putStrLn $ show $ length sol
	putStrLn sol

import Data.Sequence as S
import Data.Maybe
sHead :: Seq a -> Maybe a
sHead s =case viewl s of
	(n :< _) -> Just n
	_-> Nothing

sLast :: Seq a -> Maybe a
sLast s =case viewr s of
	(_ :> n) -> Just n
	_-> Nothing

sTail :: Seq a -> Seq a
sTail s = case viewl s of
	(_ :< n) -> n
	_ -> empty

sInit :: Seq a -> Seq a
sInit s = case viewr s of
	(n :> _) -> n
	_ -> empty

sHeadUnsafe :: Seq a ->  a
sHeadUnsafe s = fromMaybe undefined $ sHead s

sLastUnsafe :: Seq a ->  a
sLastUnsafe s = fromMaybe undefined $ sLast s

type Status a = (a,[Char])
type Situation a = (Status a,Seq a)

step :: Ord a => Situation a -> Either [Char] (Situation a)
step ((curr,directions),Empty) = Left directions
step ((curr,directions),seq)
	|curr < seqHead && curr < seqLast =
	if seqHead <= seqLast
	then
		Right ((seqHead, directions ++ "L" ), sTail seq)
	else
		Right ((seqLast, directions ++ "R" ), sInit seq)
	|curr < seqHead = Right ((seqHead, directions ++ "L" ), sTail seq)
	|curr < seqLast = Right ((seqLast, directions ++ "R" ), sInit seq)
	|otherwise = Left directions
	where
		seqHead= sHeadUnsafe seq
		seqLast= sLastUnsafe seq

steps ::Ord a => Situation a -> [Char]
steps sit =
	case step sit of
		Left l -> l
		Right s -> steps s

main = do
	n <- getLine
	l <- fmap ((map read).words) getLine
	putStrLn $ steps $ ((0,""),S.fromList l)


import Control.Monad
import Data.Int

step :: [(Int64, Int64)] -> [Int64] -> [(Int64, Int64)]
step ps ws = let
  rs = do
    ((pL, pR), w) <- zip ps ws
    let
      npL = w * pL
      npR = w * pR
    pure (min npL npR, max npL npR)
  rangeUnion (p, q) (x, y) = (min p x, max q y)
  in  tail $ scanl rangeUnion (maxBound, minBound) rs

solve :: [Int64] -> Int -> Int64
solve _ 0 = 1
solve a k = go (repeat (1, 1)) a k  where
  go sc _ 0 = snd $ last sc
  go sc at kr = go (step sc at) (tail at) (kr - 1)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    print $ solve a 5

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Data.Maybe
import Data.List
import Data.Functor
import Data.Bool
import Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8
import Text.Printf

-- import Debug.Trace

-- debug = flip trace

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromIntegral . fst . fromJust . B8.readInteger

cases :: [(Int, Int, String)]
cases = [
    (0, 5, "max"),
    (1, 4, "min"),
    (2, 3, "max"),
    (3, 2, "min"),
    (4, 1, "max"),
    (5, 0, "min")]

solve :: Int -> [Int64] -> Int64
solve n as = foldr1 max $ solvedCases
--        `debug` (show solvedCases)
    where
        solvedCases = catMaybes $ map solveCase cases

        positiveAs = sort $ filter (> 0) as
        negativeAs = reverse . sort $ filter (< 0) as
        zeros = filter (== 0) as

        solveCase (minCnt, maxCnt, ordString)
            | ((length negativeAs < minCnt) || (length positiveAs < maxCnt)) && (length zeros > 0) = Just 0
            | (length negativeAs < minCnt) || (length positiveAs < maxCnt) = Nothing
            | ordString == "max" = Just . foldr1 (*) $ ((take minCnt $ reverse negativeAs) ++ (take maxCnt $ reverse positiveAs))
            | ordString == "min" = Just . foldr1 (*) $ ((take minCnt negativeAs) ++ (take maxCnt positiveAs))
            | otherwise = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> B8.words <&> map readInt64B8
        let answer = solve n as
        printf "%s\n" $ show answer

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

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

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

main :: IO ()
main = do
  [caseNum] <- getInts
  forM_ [1..caseNum] $ \_ -> do
    _ <- getInts
    as <- getIntegers
    let nz = length $ filter (==0) as
        (ps', ns') = partition (>0) $ filter (/=0) as
        [ps, ns] = [reverse $ sort ps', sort ns']
        [lp, ln] = map length [ps, ns]
        f1 = if lp + ln < 5 then 0 else f2
        f2 = if lp == 0 || lp + ln == 5 && even lp then (if nz > 0 then 0 else product $ take 5 $ reverse $ sort $ map negate ps ++ ns) else f3
        f3 = maximum $ map (\xs -> if length xs < 5 then 0 else product xs) [take 5 ps, take 3 ps ++ take 2 ns, head ps : take 4 ns]
    printf "%d\n" f1