{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List(sort)

main :: IO ()
main = C.interact $ runScanner (numberOf testCase) >>> map (solve >>> showB) >>> C.unlines

testCase :: Scanner [Int]
testCase = numberOf int

solve :: [Int] -> Int
solve xs = iter False xs
  where
    iter _ xs | sorted xs = 0
    iter False xs = 1 + iter True (rec xs)
    iter True (x:xs) = 1 + iter False (x : rec xs)

    rec (x:x':xs) = min x x' : max x x' : rec xs
    rec xs = xs

    sorted xs = xs == sort xs

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE BangPatterns #-}

module Main where

import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)
import           Data.List
import           Data.Array
import           Control.Monad.State

main = do
  t <- fst . fromJust . C.readInt <$> C.getLine
  replicateM_ t
    $ do
      n <- fst . fromJust . C.readInt <$> C.getLine
      ps <- map (fst . fromJust . C.readInt) . C.words <$> C.getLine
      print $ solve n ps

solve :: Int -> [Int] -> Int
solve n ps = go arr 0
  where
    arr = listArray (1, n) ps

    go !a x = if isSorted a
             then x
             else go (swap a n (x+1)) (x + 1)

isSorted :: Array Int Int -> Bool
isSorted ys = snd $ foldl op (0, True) ys
  where
    op (acc, !st) x = (x, acc < x && st)

swap :: Array Int Int -> Int -> Int -> Array Int Int
swap !arr n i =
  if even i
  then arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [2, 4 .. n - 1]
      , arr ! i > arr ! (i + 1)]
  else arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [1, 3 .. n - 2]
      , arr ! i > arr ! (i + 1)]
{-
>>>solve 3 [3,2,1]
3

-}

{-# LANGUAGE BangPatterns #-}

module Main where

import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)
import           Data.List
import           Data.Array
import           Control.Monad.State

main = do
  t <- fst . fromJust . C.readInt <$> C.getLine
  replicateM_ t
    $ do
      n <- fst . fromJust . C.readInt <$> C.getLine
      ps <- map (fst . fromJust . C.readInt) . C.words <$> C.getLine
      print $ solve n ps

solve :: Int -> [Int] -> Int
solve n ps = go arr 0
  where
    arr = listArray (1, n) ps

    go a x = if isSorted a
             then x
             else go (swap a n (x+1)) (x + 1)

isSorted :: Array Int Int -> Bool
isSorted ys = snd $ foldl op (0, True) ys
  where
    op (acc, !st) x = (x, acc < x && st)

swap :: Array Int Int -> Int -> Int -> Array Int Int
swap arr n i =
  if even i
  then arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [2, 4 .. n - 1]
      , arr ! i > arr ! (i + 1)]
  else arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [1, 3 .. n - 2]
      , arr ! i > arr ! (i + 1)]
{-
>>>solve 3 [3,2,1]
3

-}


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

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

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

str = string7

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

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

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

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

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

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

solve :: SP Builder
solve = do
  n <- getInt
  k <- getInt
  a <- replicateM n getInt

  let
    prefixes = filter (\x -> length x >= 3) . map (take 3) $ tails a
    cost (x1:x2:x3:[]) = if x2 > x1 + x3 then 1 else 0
    cost x = trace (show prefixes) 0
    ansbig = sum $ map cost prefixes
    ans = if k == 1 then (n - 1) `div` 2 else ansbig
  pure $ putInts [ans]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, k :: Int, xs :: [Int]}
type Output = Int

input :: Scanner TC
input = do
  n <- int
  k <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | k == 1 = (n - 1) `div` 2
  | otherwise = length . filter id $ zipWith3 (\x y z -> y - x - z > 0) xs (tail xs) (drop 2 xs)

output :: Output -> C.ByteString
output = showB

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> Int
solve n k as
    | k == 1 = (n - 1) `div` 2
    | otherwise = L.sum $ L.zipWith3 (\a_ a ap -> if a > (a_ + ap) then 1 else 0) as (drop 1 as) (drop 2 as)

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, k :: Int, xs :: [Int]}
type Output = Int

input :: Scanner TC
input = do
  n <- int
  k <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | k == 1 = (n - 1) `div` 2
  | otherwise = length $ zipWith3 (\x y z -> y - x - z > 0) xs (tail xs) (drop 2 xs)

output :: Output -> C.ByteString
output = showB

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE TypeOperators #-}

module Main where

import Data.List
import Data.Char
import Data.Maybe
-- import Control.Applicative
import Control.Monad
import System.IO

main :: IO ()
main = do
  -- handle <- openFile "input.txt" ReadMode
  -- contents <- hGetContents handle
  contents <- getContents
  let linesOfFile = lines contents
  let a = map (\x-> read x :: Int) $ words $ (linesOfFile !! 1)
  let m = read $ (linesOfFile !! 2) :: Int
  let l = map (\x -> let k = words x; i = read (k!!0); j = read (k!!1) in (i,j)) $ drop 3 linesOfFile
  let res = solve a l
  putStrLn $ show $ res
  -- let d = initData s
  -- forM_ [1..n] $ \a0 -> do
  --   let l = words $ linesOfFile !! (2 + a0)
  --   let k = read (l!!0) :: Int
  --   let c = ord (l!!1!!0) - ord 'a'
  --   putStrLn $ show $ d!!c!!(k - 1)
  -- ii <- getLine
  -- aa <- getLine
  -- bb <- getLine
  -- let

solve a l =
  let
    s = sum a
    i = findIndex (\x-> snd x >= s) l
    e = l!!(fromJust i)
    t = fst e
  in
    if i == Nothing then -1 else maximum [s,t]

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve as ps = case dropWhile ((< s) . snd) ps of
  (l, _):_ -> max l s
  otherwise -> -1
  where s = sum as

main = do
  n <- readInt <$> B.getLine
  as <- readInts <$> B.getLine
  m <- readInt <$> B.getLine
  ps <- replicateM m ((\(l:r:_) -> (l, r)) . readInts <$> B.getLine)
  print $ solve as ps

import Control.Monad
import Data.List

parse s = let n:xs = map read . words $ s
              (as, (m:ms)) = splitAt n xs
              rs = splitPairs ms
          in (as, rs)
  where
    splitPairs [] = []
    splitPairs (a:b:xs) = (a,b):(splitPairs xs)
solve ps xs = (\(a,b) -> Just $ max x a) =<< find (\(a,b) -> x <= b) xs
  where x = sum ps
display :: Maybe Int -> String
display = (++"\n") . maybe "-1" show
main = interact (display . uncurry solve . parse)


--import Control.Monad.State
import Control.Applicative
import Control.Arrow
import Data.Traversable
import Data.Tree
import qualified Data.Map as Map
import Data.Maybe

data KMP a = KMP { done :: Bool,
                 feed :: a -> KMP a }

mkKMP' :: Ord a => KMP a -> [a] -> KMP a
mkKMP' backup [] = KMP True (feed backup)
mkKMP' backup (h : t) = KMP False (\ch -> if ch == h then mkKMP' fbh t else feed backup ch) where
  fbh = feed backup h

mkKMP :: Ord a => [a] -> KMP a
mkKMP l = start where
  start = mkKMP' (KMP False (\x -> start)) l

swap(a,b)=(b,a)
runKMP :: Ord a => KMP a -> [a] -> ([Bool], KMP a)
--runKMP kmp l = runState (traverse (\x -> modify (`feed` x) *> gets done) l) kmp
runKMP kmp l = swap $ mapAccumL (\k x -> let k' = feed k x in (k', done k')) kmp l

type Tree1 = Tree String

process :: [(Int, String)] -> Tree1
process l = gogo 1 "" where
  gogo n s = Node s $ map (uncurry gogo) (fromMaybe [] $ Map.lookup n m)
  m = Map.fromListWith (++) $ zipWith (\i (j,s) -> (j, [(i, s)])) [2..] l

go k (Node s l) = case runKMP k s of
  (ms, kk) -> length (filter id ms) + sum (map (go kk) l)
z(l,s)=go (mkKMP s) (process (map ((\[a,b]->(read a,b)).words) l))
main=interact$show.z.(init&&&last).tail.lines

import Control.Arrow
import Control.DeepSeq
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C

kmp :: Eq a => Array Int a -> Array Int Int
kmp a = pre
  where
    ix = bounds a
    pre = listArray ix $ map f $ range ix
    f i
      | i == fst ix = fst ix - 1
      | otherwise   = g $ pre!(i-1)
      where
        g j
          | a!(j+1) == a!i  = j + 1
          | inRange ix j    = g $ pre!j
          | otherwise       = fst ix - 1

auto :: (Ix a) => (a, a) -> Array Int a -> U.UArray (Int, a) Int
auto (cl, cr) a = U.array ix $ assocs $ to
  where
    (il, ir) = bounds a
    ix = ((il - 1, cl), (ir, cr))
    pre = kmp a
    to = listArray ix $ map f $ range ix
    f (i, c)
      | i < ir && a!(i+1) == c  = i + 1
      | i == il - 1             = i
      | otherwise               = force $ to!(pre!i, c)

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  (sh: st) <- fmap C.words C.getContents
  let el = zipWith (\i (j, k) -> (readInt j, (i, k))) [2..] $ pairs $ init st
      e = accumArray (flip (:)) [] (1, readInt sh) el
      s = last st
      n = C.length s
      a = listArray (1, n) $ C.unpack s
      to = auto charset a
      go (x, i) c = let j = to U.! (i, c) in force (if j == n then x + 1 else x, j)
      gao v i = foldl' (+) 0 [force $ c + gao w j |
        (w, d) <- e!v, let (c, j) = C.foldl' go (0::Int, i) d]
  print $ gao 1 0
  where
    charset = ('a', 'z')


import Control.Monad
import Data.Graph
import Data.Tree

readPair :: IO (Int, Int)
readPair = do
  [a, b] <- fmap (map read . words) getLine
  return (a, b)

main :: IO ()
main = do
  (n, m) <- readPair
  e <- replicateM m readPair
  let g = buildG (1, n) e
      c = map flatten $ components g
      f l a = filter ((==l) . length) a
      one = f 1 c
      two = f 2 c
      three = f 3 c
  if maximum (map length c) > 3 || length two > length one then putStrLn "-1"
  else do
    let (x, y) = splitAt (length two) one
        ans = (three ++) $ (zipWith (++) x two ++) $
          map (concat . take 3) $ takeWhile (not . null) $ iterate (drop 3) $ y
    forM_ ans $ \i -> do
      putStrLn $ unwords $ map show $ i

import Data.Function
import Data.List

main :: IO ()
main = interact $ unlines . map (unwords . map show) . solve . map (map read . words) . lines

solve :: [[Int]] -> [[Int]]
solve ((n : _) : ps)
  | (length $ head ts) <= 3 && (fst $ con [] bs) = as ++ (snd $ con [] bs)
  | otherwise = [[-1]]
  where
  ts = sortBy (compare `on` (0 -) . length) $ map (map fst) $ groupBy ((==) `on` snd) $ sortBy (compare `on` snd) $ zip [1..] $ foldl f [1..n] $ sort $ map sort ps
  (as, bs) = span ((== 3) . length) ts
  con ys [] = (True, ys)
  con ys (x : xs)
    | length x == 2 = if (length $ last xs) == 1
      then con ((x ++ last xs) : ys) (init xs)
      else (False, [])
    | otherwise = con ((concat $ x : take 2 xs) : ys) (drop 2 xs)
  f ps [a, b] = [if p' == pa || p' == pb then p else p' | p' <- ps]
    where
    pa = ps !! (a - 1)
    pb = ps !! (b - 1)
    p = min pa pb

import Control.Monad (liftM, replicateM)
import Data.Char (ord)
import Data.Graph (buildG, components)
import Data.Tree (flatten)
import Data.List (intercalate)

solve :: Int -> [(Int, Int)] -> Maybe [[Int]]
solve n ps
  | any ((> 3) . length) comp  =  Nothing
  | length two > length one  =  Nothing
  | otherwise  =  Just ans
  where
    graph  =  buildG (1,n) ps
    comp   =  map flatten $ components graph
    one    =  filter ((== 1) . length) comp
    two    =  filter ((== 2) . length) comp
    three  =  filter ((== 3) . length) comp
    ans    =  three ++ zipWith (++) one two ++ toTuples (drop (length two) (concat one))
    toTuples []  =  []
    toTuples (a:b:c:xs)  =  [a,b,c] : toTuples xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM m readPair
    case solve n ps of
        Nothing  ->  print (-1)
        Just as  ->  mapM_ prints as

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

import Data.Graph
import Data.Tree
import Data.List
import Control.Monad

part n [] = []
part n xs = (take n xs):part n (drop n xs)

solve :: Int -> [(Int, Int)] -> [[Int]]
solve n es
  | solutionExists = c3 ++ zipWith (++) c2 (take n2 c1) ++ (part 3 $ drop n2 $ concat c1)
  | otherwise      = [[-1]]
  where cs = map flatten $ components $ buildG (1, n) es
        c1 = filter (\x -> length x == 1) cs
        c2 = filter (\x -> length x == 2) cs
        c3 = filter (\x -> length x == 3) cs
        n1 = length c1
        n2 = length c2
        n3 = length c3
        cn = filter (\x -> length x >  3) cs
        solutionExists = null cn && n2 <= n1 && (n1 - n2) `mod` 3 == 0

readPair = fmap ((\[x, y] -> (x, y)) . map read . words) getLine

main = do (n, m) <- readPair
          es <- replicateM m readPair
          let solution = solve n es
          putStr $ unlines $ map (unwords . map show) solution

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

import Control.Applicative
import Data.List
import Data.Graph
import Data.Tree

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

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  edges <- toPairs.map (pred.read).words <$> getContents
  let gr = buildG (0,n-1) edges
  putStr.unlines.map(unwords.map show).solve.map flatten $ scc gr

solve :: [[Int]] -> [[Int]]
solve vs = go [] [] [] vs
   where
     go vs1 vs2 vs3 ([x,y,z]:rest) = go vs1 vs2 ([x,y,z]:vs3)rest
     go vs1 vs2 vs3 ([x,y]:rest) = go vs1 ([x,y]:vs2) vs3 rest
     go vs1 vs2 vs3 ([x]:rest) = go ([x]:vs1) vs2 vs3 rest
     go vs1 vs2 vs3 []
       | len1 == len2 = map (map (1+)) $ vs3 ++ zipWith(++)vs1 vs2
       | len1 < len2 = [[-1]]
       | (len1-len2)`mod`3/=0 = [[-1]]
       | otherwise = map (map (1+)) $ vs3 ++ slices 3 (concat$drop len2 vs1) ++ zipWith(++)(take len2 vs1)vs2
      where
        len1 = length vs1
        len2 = length vs2
     go _ _ _ _ = [[-1]]

slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs

import Control.Monad (liftM, replicateM)
import Data.Char (ord)
import Data.Graph (buildG, components)
import Data.Tree (flatten)
import Data.List (intercalate)

solve :: Int -> [(Int, Int)] -> Maybe [[Int]]
solve n ps
  | any ((> 3) . length) comp  =  Nothing
  | two > one  =  Nothing
  | otherwise  =  Just ans
  where
    graph  =  buildG (1,n) ps
    comp   =  map flatten $ components graph
    one    =  filter ((== 1) . length) comp
    two    =  filter ((== 2) . length) comp
    three  =  filter ((== 3) . length) comp
    ans    =  three ++ zipWith (++) one two ++ toTuples (drop (length two) (concat one))
    toTuples []  =  []
    toTuples (a:b:c:xs)  =  [a,b,c] : toTuples xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM m readPair
    case solve n ps of
        Nothing  ->  print (-1)
        Just as  ->  mapM_ prints as

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

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

import Control.Applicative
import Data.List
import Data.Graph
import Data.Tree

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

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  edges <- toPairs.map (pred.read).words <$> getContents
  let gr = buildG (0,n-1) edges
  putStr.unlines.map(unwords.map show).solve.map flatten $ scc gr

solve :: [[Int]] -> [[Int]]
solve vs = go [] [] [] vs
   where
     go vs1 vs2 vs3 ([x,y,z]:rest) = go vs1 vs2 ([x,y,z]:vs3)rest
     go vs1 vs2 vs3 ([x,y]:rest) = go vs1 ([x,y]:vs2) vs3 rest
     go vs1 vs2 vs3 ([x]:rest) = go ([x]:vs1) vs2 vs3 rest
     go vs1 vs2 vs3 []
       | len1 == len2 = map (map (1+)) $ vs3 ++ zipWith(++)vs1 vs2
       | len1 < len2 = [[-1]]
       | (len1-len2)`mod`3/=0 = [[-1]]
       | otherwise = map (map (1+)) $ slices 3 (concat$drop len2 vs1) ++ zipWith(++)(take len2 vs1)vs2
      where
        len1 = length vs1
        len2 = length vs2
     go _ _ _ _ = [[-1]]

slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs


{-# LANGUAGE LambdaCase #-}

import Control.Monad

seg_should_be_long st x y =
	st /= 0 && st == 2 * (x + y) ||
	st /= 0 && x == 0 && y == st ||
	st == 0 && x /= 0 && x == y

alt_sum = \case
	[x] -> x
	[x, y] -> x - y
	_ -> undefined

sol = sol_rec 0
	where
		sol_rec st = \case
			[] -> []
			[x] -> [[x]]
			x:y:ls ->
				let (seg, ls') =
					if seg_should_be_long st x y
					then ([x, y], ls)
					else ([x], y:ls)
				in seg:(sol_rec (st + alt_sum seg) ls')

main = do
	n <- readLn :: IO Int
	replicateM_ n $ do
		getLine
		ls <- sol <$> map read <$> words <$> getLine :: IO [[Int]]
		if sum (map alt_sum ls) == 0
		then do
			print $ length ls
			foldM_ print_segs 1 ls
		else
			print (-1)
	where
		print_segs tot seg = do
			putStrLn $ show tot ++ ' ':(show $ tot + length seg - 1)
			return $ tot + length seg

{-# LANGUAGE LambdaCase #-}

import Control.Monad

seg_should_be_long st x y =
	st /= 0 && st == 2 * (x + y) ||
	st /= 0 && x == 0 && y == st ||
	st == 0 && x /= 0 && x == y

alt_sum = \case
	[x] -> x
	[x, y] -> x - y
	_ -> undefined

sol = reverse . sol_rec [] 0
	where
		sol_rec segs st = \case
			[] -> segs
			[x] -> [x]:segs
			x:y:ls ->
				let (seg, ls') =
					if seg_should_be_long st x y
					then ([x, y], ls)
					else ([x], y:ls)
				in sol_rec (seg:segs) (st + alt_sum seg) ls'

main = do
	n <- readLn :: IO Int
	replicateM_ n $ do
		getLine
		ls <- sol <$> map read <$> words <$> getLine :: IO [[Int]]
		if sum (map alt_sum ls) == 0
		then do
			print $ length ls
			foldM_ print_segs 1 ls
		else
			print (-1)
	where
		print_segs tot seg = do
			putStrLn $ show tot ++ ' ':(show $ tot + length seg - 1)
			return $ tot + length seg


module Main where

import Data.List

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ sep $ lines input
  mapM_ putStrLn sols

sep [] = []
sep (_:xs) = head:(sep tail)
  where (head,tail) = splitAt 8 xs

parse xs = map (=='#') $ concat xs

format :: Int -> String
format x = show (i+1) ++ " " ++ show (j+1)
  where (i,j) = divMod x 8

solve :: [Bool] -> Int
solve xs = head $ filter isBishop squares
  where isBishop x = all (xs !!) [x, x-9, x+7] :: Bool
        squares = [x+8*y | x <- ids, y <- ids] :: [Int]
        ids = [1..6]

module Main where

import Control.Monad (replicateM_, replicateM)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

getPositionCharactersInString :: Char -> String -> [Int]
getPositionCharactersInString ch = map snd . filter ((== ch) . fst) . flip zip [1..]

getChessBoard :: IO [String]
getChessBoard = do
  _ <- getLine
  replicateM 8 getLine

lineBeforeBishop :: [Int] -> Bool
lineBeforeBishop [x, y] = y - x == 2
lineBeforeBishop _ = False

solution :: IO ()
solution = do
  board <- getChessBoard
  let ([x1, x2], y) = head $ filter (lineBeforeBishop . fst) $ zip (map (getPositionCharactersInString '#') board) [2..]
  putStrLn $ show y <> " " <> show ((x1 + x2) `div` 2)

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

rd :: Int -> IO [String]
rd 0 = pure []
rd i = do
  s <- getLine
  ans <- rd $ i - 1
  pure (s: ans)

findH :: [String] -> Int -> Int -> (Int, Int)
findH a x y = if (&&) ((&&) (a !! (x - 1) !! (y - 1) == '#') (a !! (x - 1) !! (y + 1) == '#')) ((&&) (a !! (x + 1) !! (y - 1) == '#') (a !! (x + 1) !! (y + 1) == '#'))
  then (x, y)
  else if y == 6
    then findH a (x + 1) 1
    else findH a x (y + 1)

find :: [String] -> (Int, Int)
find a = findH a 1 1

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  s <- tail <$> (rd 9)
  let (x, y) = find s
  putStrLn $ show (x + 1) ++ " " ++ show (y + 1)
  solve $ i - 1

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


{-# LANGUAGE Safe #-}

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

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

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

solve :: Int -> [Int] -> Integer
solve k = sum . map toInteger . take (k + 1) . reverse . sort

import Control.Monad
import Data.List
import Data.Int

main :: IO()
main = do
  t <- readLn
  replicateM_ t $ do
    inputs <- map (read) <$> words <$> getLine
    line <- getLine
    print $ sum $ take ((inputs!!1) + 1) $ reverse $ (sort $ map (read) $ words line :: [Int64])

import Control.Monad
import Data.List

main :: IO()
main = do
  t <- readLn
  replicateM_ t $ do
    inputs <- map (read) <$> words <$> getLine
    line <- getLine
    print $ sum $ take ((inputs!!1) + 1) $ reverse $ (sort $ map (read) $ words line :: [Integer])

import Data.List
import Control.Monad

main = do
  cases <- read <$> getLine
  replicateM cases $ do
    (n:k:_) <- map read <$> words <$> getLine
    barrels <- map read <$> words <$> getLine
    putStrLn $ show $ maximalPourDiff k barrels

maximalPourDiff :: Int -> [Integer] -> Integer
maximalPourDiff k barrels = sum $ take (k+1) $ reverse $ sort barrels

{-# LANGUAGE Safe #-}

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

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

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

solve :: Int -> [Int] -> Int
solve k = sum . take (k + 1) . reverse . sort

import Data.List
import Control.Monad

main = do
  cases <- read <$> getLine
  replicateM cases $ do
    (n:k:_) <- map read <$> words <$> getLine
    barrels <- map read <$> words <$> getLine
    putStrLn $ show $ maximalPourDiff k barrels

maximalPourDiff :: Int -> [Int] -> Int
maximalPourDiff k barrels = sum $ take (k+1) $ reverse $ sort barrels


module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M

transform :: [(Int, Char)] -> M.Map Int Char -> [Char]
transform [] _ = []
transform ((d, c):rs) m =
  case M.lookup d m of
    (Just c') -> c' : transform rs m
    Nothing  -> c : transform rs m'
                where m' = M.insert d c m

solveProblem :: [(Int, Char)] -> Bool
solveProblem rs = transform rs M.empty == map snd rs

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

handleProblem :: IO ()
handleProblem = do
  getLine
  numbers <- map read . words <$> getLine
  letters <- getLine
  putStrLn $ formatSolution $ solveProblem $ numbers `zip` letters

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

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

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

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

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

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

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

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

#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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> B8.ByteString -> Bool
solve n as s = L.length counterExamples == 0
    where
        str = B8.unpack s
        counterExamples = do
            x1@(a1, c1) <- zip as str
            x2@(a2, c2) <- zip as str
            M.guard $ a1 == a2 && c1 /= c2
            M.guard $ not (x1 == x2)
            tracingM "x1" x1
            tracingM "x2" x2
            return True

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        s <- B8.getLine <&> B8.filter isAlphaNum
        let answer = solve n as s
        putsYesNo answer


import Data.Array

isPrime n = isPrime' n 2
    where
    isPrime' n i
        | i * i > n = True
        | n `mod` i == 0 = False
        | otherwise = isPrime' n (i + 1)

solve input =
    let n = (read input)::Int in
    let primes = filter isPrime [2..500] in
    let a = listArray (0, (length primes) - 1) primes in
    case n of
        2 -> show(-1)
        _ ->
            let res = ((a ! 0) * (a ! 1)) : ((a ! 0) * (a ! 2)) : ((a ! 1) * (a ! 2)) : (map (\x -> (a ! x) * (a ! 1) * (a ! 2)) [3..(n - 1)]) in
            let out = map (show) res in
            unlines out

main = interact(solve)

import Data.List

primes = 2 : 3 : [p | p <- [5,7..],
                  all (\x -> p `mod` x /= 0) $ takeWhile (\x -> x*x<=p) primes]

ok xs = length xs /= 2 &&
        all (\x -> all (\y -> gcd x y /= 1) xs) xs &&
        all ((<=100).length.show) xs

main = do
  n <- readLn
  let ps = take (n+1) primes
      ps' = take n primes
      xs' = map product $ take (n-1) $ tails ps'
      xs = head xs' : map (last ps*) (tail xs') ++ [last ps * 2]
  if ok xs then mapM_ print xs else print (-1)

main :: IO ()
main = do
	n <- getLine
	let nn = read n :: Int
--	sequence (map print (solve nn))
	mapM_ print (solve nn)

solve :: Int -> [Integer]
solve 2 = [-1]
solve n = (product xs) : (map (2 * ) xs) where (x : xs) = take n er

er = erpr [2..]
erpr (x : xs) = x : erpr [y | y <- xs, y `mod` x /= 0]

main :: IO ()
main = do
	n <- getLine
	let nn = read n :: Int
	mapM_ print (solve nn)

solve :: Int -> [Int]
solve 2 = [-1]
solve n = 10 : 15 : map (6 *) [1..n-2]

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        m = 10^100
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
    if n < 3 || any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
        m = 10^100
    if n < 3 || any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List
probe x s = if all (\a -> x `mod` a /= 0) s then x else probe (x+1) s
prime k ss | length ss < k = prime k ((probe (head ss) ss):ss)
           | otherwise = reverse ss
main = do
    n <- readIO =<< getLine
    let p = prime n [2]
        l = map (\i -> product ((p!!(i-1))`delete`p)) [1..n]
        m = 10^100
    if any (>= m) l then putStrLn "-1" else mapM_ (putStrLn.show) l

import Data.List

primes = 2 : 3 : [p | p <- [5,7..],
                  all (\x -> p `mod` x /= 0) $ takeWhile (\x -> x*x<=p) primes]

ok xs = all (\x -> all (\y -> gcd x y /= 1) xs) xs &&
        all ((<=100).length.show) xs

main = do
  n <- readLn
  let ps = take (n+1) primes
      x = product (last ps : take (n-1) ps)
      xs = map product $ take (n-1) $ tail (tails ps)
  if ok (x:xs) || True then mapM_ print (x:xs) else print (-1)


module Main where

import Control.Applicative
import Control.Monad
import Prelude hiding (id)

import qualified Data.Map as M

solve :: [(Int, String)] -> M.Map Int Int -> Int -> Int
solve [] _ acc = acc
solve ((id, sign) : xs) m acc
    | sign == "+" = let newacc = max (M.size newm) acc
                        newm = M.insert id 0 m
                     in solve xs newm newacc
    | otherwise = if M.member id m then solve xs (M.delete id m) acc
                                   else solve xs m (acc + 1)

main :: IO ()
main = do
    n <- (\s -> read s :: Int) <$> getLine
    xs <- replicateM n (do
                       (sign, id) <- ((\[s, i] -> (s, read i :: Int)) . words) <$> getLine
                       return (id, sign))
    print $ solve xs M.empty 0

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

trans :: [String] -> [(Int, Int)]
trans []       = []
trans (op:r:s) | op == "+" = (1, (read r)):(trans s)
               | otherwise = (0, (read r)):(trans s)

solve :: [(Int, Int)] -> Int
solve r = solve' (reverse (complete (reverse r) [])) []
    where
        solve' :: [(Int, Int)] -> [Int] -> Int
        solve' []          a = length a
        solve' ((1, r):rs) a = solve' rs (insertTo a r)
        solve' ((0, r):rs) a = solve' rs (removeFrom a r)

removeElem :: [Int] -> Int -> [Int]
removeElem [] v     = []
removeElem (l:ls) v | l == v    = ls
                    | otherwise = l:(removeElem ls v)

complete :: [(Int, Int)] -> [Int] -> [(Int, Int)]
complete [] []         = []
complete [] (c:cs)     = (1, c):(complete [] cs)
complete ((0, r):rs) c = (0, r):(complete rs (r:c))
complete ((1, r):rs) c = (1, r):(complete rs (removeElem c r))

insertTo :: [Int] -> Int -> [Int]
insertTo []     v = [v]
insertTo (0:rs) v = v:rs
insertTo (r:rs) v = r:(insertTo rs v)

removeFrom :: [Int] -> Int -> [Int]
removeFrom (r:rs) v | r == v    = 0:rs
                    | otherwise = r:(removeFrom rs v)

import Control.Monad
import Data.List

main = do
    n <- fmap read getLine
    rs <- forM [1..n] (\_ -> fmap ((\[ch,v] -> (head ch, read v)) . words) getLine)
    print $ solve rs

solve :: [(Char, Int)] -> Int
solve (x:xs) = g [] 0 $ f [] x xs
    where f l1 (ch, v) (x:xs) = if ch == '-' && noPlus v l1 then f (('+', v):l1 ++ [('-', v)]) x xs
                                else f (l1 ++ [(ch, v)]) x xs
          f l1 (ch, v) [] = if ch == '-' && noPlus v l1 then (('+', v):l1 ++ [('-', v)])
                            else (l1 ++ [(ch, v)])
          g :: [Int] -> Int -> [(Char,Int)] -> Int
          g sys m (('+',v):xs) = g (v:sys) (max m $ length sys + 1) xs
          g sys m (('-',v):xs) = g (sys\\[v]) m xs
          g _ m [] = m

noPlus :: Int -> [(Char, Int)] -> Bool
noPlus v = all (\(ch,v1) -> ch /= '+' || v /= v1)


import System.IO
import Control.Applicative
{-import Data.HashSet-}
import Data.Bits
import qualified Data.Map as Map
import Data.Tuple

parse :: String -> Int -> [Int]
parse input line_idx  = map read $ words $ lines input !! line_idx

solve :: String -> String
solve input = (show $ answer x as ) ++ "\n"
{-solve input = (show $ merged_map x as ) ++ "\n"-}
        where
          n = parse input 0 !! 0 :: Int
          x = parse input 0 !! 1 :: Int
          as = parse input 1 :: [Int]

type Mymap = Map.Map Int (Int, Int)

answer x as
    | pre_answer == 3  = -1
    | otherwise        = pre_answer
        where
            pre_answer = foldl min 3 (map extractEachAnswer ( Map.elems (counter (.&.x) as)) )

extractEachAnswer :: (Int, Int) -> Int
extractEachAnswer (a, b)
    | a>=2  = 0
    | a>=1 && b>=1 && a+b>=2 = 1
    | b>=2  = 2
    | otherwise = 3

{-counter :: [Int] -> Mymap-}
counter func as = foldr (addToMap func) Map.empty as

addToMap :: (Int -> Int) -> Int -> Mymap -> Mymap
addToMap func a = Map.alter modifier a . (if (func a) /= a then Map.alter modifier2 (func a) else id)
    where
    modifier2 = mswap . modifier . mswap
        where
        mswap = fmap swap

modifier :: Maybe (Int, Int) -> Maybe (Int, Int)
modifier Nothing = Just (1, 0)
modifier (Just (a, b)) = Just (a+1, b)

main = (solve <$> getContents) >>= putStr

import Data.Bits
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

op = (.&.)

doit x [] w = False
doit x (a:as) w =
  let t = op a x in
  if t /= a && (Map.findWithDefault 0 t w) > 0 then
    True
  else
    doit x as w

solve::String -> String
solve ss =
  let (n:x:a) = Prelude.map toint $ words ss in
  let w = asdasd a in
  if (Map.size w) < n then
    "0\n"
  else
    if doit x a w then
      "1\n"
    else
      let ww = asdasd (map (\t -> op t x) a) in
      if (Map.size ww) < n then
        "2\n"
      else
        "-1\n"

main = interact solve

-- import Data.Counter (count, empty)
import qualified Data.Map as M
import Data.Bits ((.&.))

count :: [Int] -> M.Map Int Int
count = foldr (\k -> M.insertWith (+) k 1) M.empty

main = do
    n:x:[] <- fmap (map read . words) getLine
    a <- fmap (count . map read . words) getLine
    if M.size a < n
    then print 0
    else if any (\v -> (v /= v .&. x) && M.member (v .&. x) a) $ M.keys a
        then print 1
        else if n > (M.size $ M.mapKeys (.&. x) a)
            then print 2
            else print (-1)

import Data.Bits
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

op = (.&.)

doit x [] w = False
doit x (a:as) w =
  let t = op a x in
  if t /= a && (Map.findWithDefault 0 t w) > 0 then
    True
  else
    doit x as w

solve::String -> String
solve ss =
  let (n:x:a) = Prelude.map toint $ words ss in
  let w = asdasd a in
  if (Map.size w) < n then
    "0\n"
  else
    if doit x a w then
      "1\n"
    else
      let ww = asdasd (map (\t -> op t x) a) in
      if (Map.size w) < n then
        "2\n"
      else
        "-1\n"

main = interact solve


import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = output . solve . drop 2 . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

output :: Bool -> IO ()
output True = putStrLn "NO"
output False = putStrLn "YES"

solve :: [Int] -> Bool
solve [] = True
solve (n:x) = let (a, s) = splitAt n x
                  r = sort $ filter (> 0) a
                  m = sort $ map abs $ filter (< 0) a
              in check r m && solve s

check :: [Int] -> [Int] -> Bool
check [] _ = False
check _ [] = False
check (a:ax) (b:bx) | a == b    = True
                    | a < b     = check ax (b:bx)
                    | otherwise = check (a:ax) bx

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import Control.Monad (forM)
import Data.List (nub)

main = do
    (map (read :: String -> Int) . words -> [n, m]) <- getLine
    xs <- forM [1..m] $ \i -> do
        (map abs . nub . map (read :: String -> Int) . tail . words -> x) <- getLine
        return x
    let f True _ = True
        f False x = length x == length (nub x)
    if foldl f False xs then
        putStrLn "YES"
    else
        putStrLn "NO"

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

main = do
  [nu, ng] <- fmap readInts B.getLine
  gs <- replicateM ng $ fmap (tail . readInts) B.getLine
  putStr $ if solve gs then "YES" else "NO"

solve = any (\g -> let s = S.fromList g in all (\m -> S.notMember (-m) s) g)

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

{-# LANGUAGE ViewPatterns #-}
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.IntSet           (fromList, intersection, null)
import           Data.List             (partition, unfoldr)
import           Prelude               hiding (null)

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

main :: IO ()
main = do
  [_, m] <- getInts
  groups <- replicateM m getInts
  putStrLn $ if any traitor groups then "YES" else "NO" where
    traitor nums = let (pos, fmap negate -> neg) = partition (> 0) $ tail nums
                   in null (fromList pos `intersection` fromList neg)

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, insert x set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls
    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

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

main = do
  [nu, ng] <- fmap readInts B.getLine
  gs <- replicateM ng $ fmap (tail . readInts) B.getLine
  print $ if solve gs then "YES" else "NO"

solve = any (\g -> let s = S.fromList g in all (\m -> S.notMember (-m) s) g)

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

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls

    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

{-# LANGUAGE ViewPatterns #-}
import Data.Set
import Control.Monad
import Data.Set as S
import Prelude as P

f (b, set) x | S.member (-1*x) set = (b && False, insert x set)
    | otherwise = (b || False, insert x set)

main = do
    (fmap (read::String -> Int) . words -> [n, m]) <- getLine
    (P.map  (P.map (read :: String -> Int) . tail. words) -> ls) <- replicateM m getLine
    let g = P.foldl f (True, S.empty)
    let res =  P.map (fst . (\ xs -> if (size $ snd $ g xs) == 1 then (True, S.empty) else g xs))  ls
    print res
    if (or res)
        then putStrLn "YES"
        else putStrLn "NO"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import Control.Monad (forM_, forM)
import Data.List (nub)

main = do
    (map (read :: String -> Int) . words -> [n, m]) <- getLine
    xs <- forM [1..m] $ \i -> do
        (map (abs . (read :: String -> Int)) . tail . words -> x) <- getLine
        return x
    let f True _ = True
        f False x = length x == length (nub x)
    if foldl f False xs then
        putStrLn "YES"
    else
        putStrLn "NO"


import Control.Applicative
import Data.Array.Unboxed
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
	_ <- readLn :: IO Int
	w <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine
	putStrLn . show $ solve w

solve :: [Int] -> Int
solve w = f 0 0 . elems $ arr
	where
		arr					= accumArray (+) 0 (0, 100 + 10 ^ 6) $ [(x, 1) | x <- w] :: UArray Int Int
		f ans _ []			= ans
		f ans k (x : xs)	= f (ans + ((k + x) .&. 1)) ((k + x) `shiftR` 1) xs

{--import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array.IO

solve :: [Int] -> IO Int
solve w = do
    arr <- newArray (0,2*10^6) False :: IO (IOArray Int Bool)
    mapM (add arr) w
    length . filter id <$> getElems arr
    where
        add arr i = do
            x <- readArray arr i
            if x
                then do
                    writeArray arr i False
                    add arr (i+1)
                else writeArray arr i True

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print =<< solve w--}

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

process::Int->[Int]->Int
process n [] = n
process n [0] = n
process n (a:b:as) | a==0 = process n (b:as)
                   | even a = process n ((b+ div a 2):as)
	           | otherwise = process (n+1) ((b+ div a 2):as)

main= do
	getLine
	s<-    map ( fst.fromJust.C.readInt).C.words <$> C.getLine ::IO [Int]
	let q = 50+(maximum s)
	let a= accumArray (+) 0 (0,(min q 1000050)) $  zip s (repeat 1)
	print $   process 0 $ elems a

import Control.Applicative
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
	_ <- readLn :: IO Int
	w <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine
	putStrLn . show $ solve w

solve :: [Int] -> Int
solve w = f 0 0 . elems $ arr
	where
		arr					= accumArray (+) 0 (0, 100 + 10 ^ 6) $ [(x, 1) | x <- w] :: UArray Int Int
		f ans _ []			= ans
		f ans k (x : xs)	= f (ans + ((k + x) `mod` 2)) ((k + x) `div` 2) xs

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

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (x:xs) pre
    | x == pre = solve xs (pre+1)
    | x == pre-1 = 1 + solve xs pre
    | otherwise = 1 + solve xs x

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = (cnt-1) `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (x:xs) pre
    | x == pre = solve xs (pre+1)
    | otherwise = 1 + solve xs x

main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = cnt `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] _ _ = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 0 && x == pre + 1 = cnt `div` 2 + solve xs 1 x
    | otherwise = 1 + solve xs 0 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 0 (-1)

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

solve :: [Int] -> Int -> Int -> Int
solve [] cnt _
    | cnt > 2 = (cnt-1) `div` 2
    | otherwise = 0
solve (x:xs) cnt pre
    | x == pre = solve xs (cnt+1) x
    | cnt > 1 && x == pre + 1 = (cnt-1) `div` 2 + solve xs 2 x
    | otherwise = 1 + (cnt-1) `div` 2 + solve xs 1 x
main :: IO ()
main = do
    n <- readLn :: IO Int
    w <- map fst . mapMaybe C.readInt . C.words <$> C.getLine
    print $ solve w 1 (-1)


{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

tsomenode x i !seed = Node x seed x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 32767) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme !seed = (.&.) (shiftR (seed * 214013 + 2531011) 16) 32767

tsomenode x i !seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 10000000) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits
import System.Random

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

tsomenode x i !seed = Node x seed x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node !x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ !y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ !mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ !sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ !i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) 0 0 (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) 0 0 (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t !left !right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead !left !right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t _ = t
solve ((a,c):acs) !n t g =
  let pos = (binSrch t a n (max 1 (n - c)) n)
      (nr, ng) = randomR (1, 10000000) g in
      solve acs (n + 1) (tadd t (tsomenode a n nr) pos) ng

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers !n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  g <- newStdGen
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil g) [])

import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme (s1,s2,s3) = xor (1237 * s1 + 5129 * s2 + 3287 * s3 + 12485) 73813

tsomenode x i seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) (tmax n) (tsize n) (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t left right
 | tnull t = -infinit
 | left > right = -infinit
 | (left == 1) && (right == (tsize t)) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead left right
 | left > right = rhead
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t = t
solve ((a,c):acs) n t =
  let pos = (binSrch t a n (max 1 (n - c - 1)) n) in
      solve acs (n + 1) (tadd t (tsomenode a n (a,c,n)) pos)

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil) [])

import Data.List
import Data.Char (ord, chr)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as DBS
import Data.Bits

infinit = 10000000

data Treap = Nil | Node Int Int Int Int Int Treap Treap deriving Show
-------------------------x---y--max--sz--id--left-right

seedme (s1,s2,s3) = xor (1237 * s1 + 5129 * s2 + 3287 * s3 + 12485) 73813

tsomenode x i seed = Node x (seedme seed) x 1 i Nil Nil

tnull Nil = True
tnull _ = False

tx Nil = 0
tx (Node x _ _ _ _ _ _) = x

ty Nil = 0
ty (Node _ y _ _ _ _ _) = y

tmax Nil = -infinit
tmax (Node _ _ mx _ _ _ _) = mx

tsize Nil = 0
tsize (Node _ _ _ sz _ _ _) = sz

tidnum Nil = 0
tidnum (Node _ _ _ _ i _ _) = i

tleft Nil = Nil
tleft (Node _ _ _ _ _ l _) = l

tright Nil = Nil
tright (Node _ _ _ _ _ _ r) = r

trecalc Nil = Nil
trecalc (Node x y _ _ i l r) = Node x y (max x (max (tmax l) (tmax r))) (1 + (tsize l) + (tsize r)) i l r

tsplit root k
 | (tnull root) = (Nil, Nil)
 | k <= ((tsize.tleft) root) =
   let (l, r) = tsplit (tleft root) k
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) r (tright root)) in
       (l, nroot)
 | otherwise =
   let (l, r) = tsplit (tright root) (k - ((tsize.tleft) root) - 1)
       nroot = trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) l) in
       (nroot, r)

tadd root n k
 | (tnull root) = n
 | (ty n) > (ty root) =
   let (l, r) = tsplit root (k - 1) in
       trecalc (Node (tx n) (ty n) (tmax n) (tsize n) (tidnum n) l r)
 | k <= ((tsize.tleft) root) + 1 =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tadd (tleft root) n k) (tright root))
 | otherwise =
   trecalc (Node (tx root) (ty root) (tmax root) (tsize root) (tidnum root) (tleft root) (tadd (tright root) n (k - ((tsize.tleft) root) - 1)))

maxInInterval t left right
 | tnull t = -infinit
 | left > right = -infinit
 | (right - left + 1) == (tsize t) = tmax t
 | otherwise =
  let ltree = tleft t
      rtree = tright t
      lsz = tsize ltree
      lszpo = lsz + 1
      rsz = tsize rtree
      lmax = maxInInterval ltree left (min lsz right)
      osl = left - lszpo
      osr = right - lszpo
      rmax = maxInInterval rtree (max osl 1) (min osr rsz)
      cmax = if (left <= lszpo) && (right >= lszpo) then (tx t) else (-infinit) in
      (max cmax) $ max lmax rmax

binSrch t a rhead left right
 | left > right = infinit
 | otherwise =
     let mid = left + ((right - left) `div` 2)
         cand = maxInInterval t mid rhead in
         if cand < a
            then min mid (binSrch t a rhead left (mid - 1))
            else binSrch t a rhead (mid + 1) right

solve [] _ t = t
solve ((a,c):acs) n t =
  let pos = (binSrch t a n (max 1 (n - c)) n) in
      solve acs (n + 1) (tadd t (tsomenode a n (a,c,n)) pos)

extractInt Nothing = 0
extractInt (Just (a, _)) = a

readNumbers 0 = return []
readNumbers n = do
  [a,c] <- fmap ( (map (\x -> extractInt (DBS.readInt x))) . DBS.words ) DBS.getLine
  rest <- readNumbers (n - 1)
  return ((a,c):rest)

inorder t sofar
 | tnull t = sofar
 | otherwise =
   let sf2 = inorder (tright t) sofar
       sf3 = (tidnum t):sf2 in
       inorder (tleft t) sf3

main = do
  n <- readLn::IO Int
  v <- readNumbers n
  DBS.putStrLn $ DBS.unwords $ map (DBS.pack.show) (inorder (solve v 1 Nil) [])


import Control.Applicative

slice n xs = map (take n) $ takeWhile (\x -> x /= []) (iterate (drop n) xs)

parse (x : y : z : xs) = if (x == y && y == z) then 1 else 0
parse _ = 0

solve n s = sum $ (map (parse . reverse) $ init (slice n s))

main =
	do n <- read <$> getLine
	   s <- getLine
	   print $ solve n s

main = interact $ show . fi . lines
fi (n:s:[]) = go (read n) s
go n s | length s > n = (if eq == True then 1 else 0) + (go n $ drop n s)
       | otherwise = 0
       where eq = foldl (\i x -> i || all x (drop (n-3) $ take n s)) False [(=='b'),(=='a')]

solve :: Int -> String -> Int
solve n s  =  length $ filter good $ init $ group s
  where
    good as  =  case reverse as of
        (a1 : a2 : a3 : _)  ->  a1 == a2 && a2 == a3
    group []  =  []
    group xs  =  take n xs : group (drop n xs)

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    print $ solve n s

import Control.Applicative

main = f <$> readLn <*> getLine >>= print

f n (_:cs) = length.filter (p.drop (n-4)) $ slices n cs

p [x,y,z,_] = x==y && y==z
p _ = False

slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate (drop n) xs

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

newtype State s a = State { runState :: s -> (a,s) }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    n <- readLine
    s <- getLine
    print $ solve n s

solve :: Int -> String -> Int
solve n s = length $ filter (check n) (split n (tail s))

split n [] = []
split n l  = take n l:split n (drop n l)

check n l | length l < n = False
          | otherwise = case reverse l of
    _:'a':'a':'a':_ -> True
    _:'b':'b':'b':_ -> True
    _               -> False

main = interact ( show . af . conv . lines )
conv l = ( read . head $ l, last l )
h = splitAt
f n l | length l < n = 0
      | otherwise    = g ( reverse $ fst ( h n l ) ) + f n ( snd ( h n l ) )
g ( a:b:c:d:t ) | b == c && c == d = 1
                | otherwise        = 0
af ( x,y ) = f x ( tail y )

{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,TypeSynonymInstances #-}

import Control.Monad
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a

newtype State s a = State { runState :: s -> (a,s) }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

main = do
    n <- readLine
    s <- getLine
    print $ solve n s

solve :: Int -> String -> Int
solve n s = length $ filter (check n) (split n (tail s))

split n [] = []
split n l  = take n l:split n (drop n l)

check n l | length l < n = False
          | otherwise = (==1) $ length $ group $ take (n-1) l

main = interact $ show . fi . lines
fi (n:s:[]) = go (read n) s
go n s | length s >= n = (if eq == True then 1 else 0) + (go n $ drop n s)
       | otherwise = 0
       where eq = foldl (\i x -> i || all x (drop (n-3) $ take n s)) False [(=='b'),(=='a')]


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 qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))

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

type Set = S.Set Integer

solve :: String -> String -> Bool
solve a b = aux (n-1) False

	where
		n = length a
		aA = A.listArray (0, n-1) a
		bA = A.listArray (0, n-1) b
		aux i inv
			| i == -1 = True
			| test /= inv = aux (i-1) inv
			| test == inv && S.member i set = aux (i-1) (not inv)
			| otherwise = False
			where
				test = aA ! i == bA ! i

		num0_1 [] _ _ = []
		num0_1 ('0':xs) i j = (i+1, j):num0_1 xs (i+1) j
		num0_1 ('1':xs) i j = (i, j+1):num0_1 xs i (j+1)
		set = S.fromList [i | (i, (x, y))<-zip [0..] (num0_1 a 0 0), x==y]

showR :: Bool -> IO ()
showR False = putStrLn "NO"
showR True = putStrLn "YES"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		a <- getLine
		b <- getLine
		showR $ solve a b

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (find)
import Data.Maybe (fromMaybe)

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

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (g, gs) = splitAt k xs
   in g : chunksOf k gs

type CC = (Char, Char) -- pair of chars

type PString = [CC] -- string of pair of chars

solve :: [String] -> Bool
solve [_, a, b] =
  let (g:gs) = decomp $ zip a b
   in all ok gs && uncurry (==) (unzip g)

ok :: PString -> Bool
ok = liftA2 (||) (all (uncurry (==))) (not . any (uncurry (==)))

decomp :: PString -> [PString]
decomp = (\(_, e, es) -> e : es) . foldl extend (0, [], [])
  where
    extend :: (Int, PString, [PString]) -> CC -> (Int, PString, [PString])
    extend (s, g, gs) (ai, bi) =
      let s' =
            s +
            if ai == '0'
              then 1
              else (-1)
          g' = (ai, bi) : g
       in if s' == 0
            then (0, [], g' : gs)
            else (s', g', gs)

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (find)
import Data.Maybe (fromMaybe)

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

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (g, gs) = splitAt k xs
   in g : chunksOf k gs

type CC = (Char, Char) -- pair of chars

type PString = [CC] -- string of pair of chars

solve :: [String] -> Bool
solve [_, a, b] = all ok $ decomp $ zip a b

ok :: PString -> Bool
ok = liftA2 (||) (all (uncurry (==))) (not . any (uncurry (==)))

decomp :: PString -> [PString]
decomp = (\(_, _, e) -> e) . foldr extend (0, [], [])
  where
    extend :: CC -> (Int, PString, [PString]) -> (Int, PString, [PString])
    extend (ai, bi) (s, g, gs) =
      let s' =
            s +
            if ai == '0'
              then 1
              else (-1)
          g' = (ai, bi) : g
       in if s' == 0
            then (0, [], g' : gs)
            else (s', g', gs)

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 qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))

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

type Set = S.Set Integer

solve :: String -> String -> Bool
solve a b = aux (n-1) True || aux (n-1) False

	where
		n = length a
		aA = A.listArray (0, n-1) a
		bA = A.listArray (0, n-1) b
		aux i inv
			| i == -1 = True
			| aA ! i /= bA ! i && inv = aux (i-1) inv
			| aA ! i == bA ! i && not inv = aux (i-1) inv
			| aA ! i == bA ! i && inv && S.member i set = aux (i-1) (not inv)
			| aA ! i /= bA ! i && not inv && S.member i set = aux (i-1) (not inv)
			| otherwise = False

		num0_1 [] _ _ = []
		num0_1 ('0':xs) i j = (i+1, j):num0_1 xs (i+1) j
		num0_1 ('1':xs) i j = (i, j+1):num0_1 xs i (j+1)
		set = S.fromList [i | (i, (x, y))<-zip [0..] (num0_1 a 0 0), x==y]

showR :: Bool -> IO ()
showR False = putStrLn "NO"
showR True = putStrLn "YES"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		a <- getLine
		b <- getLine
		showR $ solve a b


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

solve :: IO ()
solve = do
    ~[n] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let f t = if t `isInfixOf` s then Just (length t) else Nothing
    print $ fromMaybe (-1) $ asum $ map f ss

ss :: [String]
ss =
    [ "aa"
    , "aba"
    , "aca"
    , "abca"
    , "acba"
    , "abbacca"
    , "accabba"
    ]

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, s :: String}

input :: Scanner TC
input = do
  n <- int
  s <- str
  return TC {..}

type Output = Int

output :: Output -> C.ByteString
output = showB

solve :: TC -> Output
solve TC {..} = if null cands then -1 else minimum cands
  where
    cands = [length w | w <- ["aa", "aba", "aca", "abca", "acba", "abbacca", "accabba"], w `substring` s]

substring _ [] = False
substring w s = w == take (length w) s || substring w (tail s)

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, s :: String}

input :: Scanner TC
input = do
  n <- int
  s <- str
  return TC {..}

type Output = Int

output :: Output -> C.ByteString
output = showB

solve :: TC -> Output
solve TC {..}
  | "aa" `elem` g = 2
  | "b" `elem` g || "c" `elem` g = 3
  | "bc" `elem` g || "cb" `elem` g = 4
  | otherwise = -1
  where
    g =
      debug
        . groupOn (== 'a')
        . dropWhile (/= 'a')
        . reverse
        . dropWhile (/= 'a')
        $ s

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, s :: String}

input :: Scanner TC
input = do
  n <- int
  s <- str
  return TC {..}

type Output = Int

output :: Output -> C.ByteString
output = showB

solve :: TC -> Output
solve TC {..}
  | ('a', 'a') `elem` adjacents s = 2
  | "b" `elem` g || "c" `elem` g = 3
  | "bc" `elem` g || "cb" `elem` g = 4
  | otherwise = -1
  where
    g =
      filter ((/= 'a') . head)
        . groupOn (== 'a')
        . dropWhile (/= 'a')
        . reverse
        . dropWhile (/= 'a')
        $ s

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show