{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . addCnt . (map fromOp).sol.(map toOp).tail . lines

type Op = (Char, Int)

eval :: Char -> (Int -> Int -> Int)
eval = \case
    '|' -> (.|.)
    '&' -> (.&.)
    '^' -> xor

apply :: Int -> Op -> Int
apply v (o,w) =  (eval o) v w

sol os = let (o,a,x)=foldl ff (0,(1`shiftL`32) - 1,0) list in [('|', o), ('&',a), ('^',x)]
  where
    _0s = ev 0 os
    _1s = ev 1023 os
    list = zipWith idf _1s _0s
    idf (n, v) (n', w) = assert (n==n') $ (n, (v,w))
    ff :: (Int, Int, Int) -> (Int, (Bool,Bool)) -> (Int, Int, Int)
    ff (o,a,x) (n, pv) = let b=shiftL 1 n in case pv of
        (True, True)   -> (o.|.b, a,       x)
        (True, False)  -> (o,     a,       x)
        (False, True)  -> (o,     a,       x.|.b)
        (False, False) -> (o,     a`xor`b, x)
    ev n os = toBitMap $ foldl apply n os

toOp :: String -> Op
toOp s = (op, arg)
    where [[op], arg'] = words s
          arg = read arg'

fromOp :: Op -> String
fromOp (op, arg) = op : " " ++ show arg

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0
allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)
swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)
wrap :: a -> [a]
wrap x = [x]
toSnd :: a->b-> (a,b)
toSnd x y = (x,y)
toFst :: b->a-> (a,b)
toFst y x = (x,y)
addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls
toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE DeriveGeneric, BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Bits
import GHC.Generics
import Control.DeepSeq

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  (\(a, o, x) -> "3\n& " ++ show a ++ "\n| " ++ show o ++ "\n^ " ++ show x) `fmap` solve `fmap` replicateM n (liftM2 (\a b -> (B.head a, b)) pop poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

data Op = Id | Neg | Set0 | Set1 deriving (Show, Generic)
instance NFData Op
neg Neg = Id
neg Id = Neg
neg Set0 = Set1
neg Set1 = Set0

comb x '|' False = x
comb _ '|' True = Set1
comb x '^' False = x
comb x '^' True = neg x
comb _ '&' False = Set0
comb x '&' True = x

solve :: [(Char, Int)] -> (Int, Int, Int)
solve os = foldl' (\s@(!a, !o, !x) (i, c) -> case c of { Id -> s; Neg -> (a, o, x `setBit` i); Set0 -> (a `clearBit` i, o, x); Set1 -> (a, o `setBit` i, x) }) (1023, 0, 0) $ zip [0..] $ foldl' (\cs (o, n) -> force $ zipWith (\i c -> comb c o (n `testBit` i) :: Op) [0..] cs) (replicate 10 Id) os

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE DeriveGeneric, BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Bits
import GHC.Generics
import Control.DeepSeq

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  (\(a, o, x) -> "3\n& " ++ show a ++ "\n| " ++ show o ++ "\n^ " ++ show x) `fmap` solve `fmap` replicateM n (liftM2 (\a b -> (B.head a, b)) pop poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

data Op = Id | Neg | Set0 | Set1 deriving (Show, Generic)
instance NFData Op
neg Neg = Id
neg Id = Neg
neg Set0 = Set1
neg Set1 = Set0

comb x '|' False = x
comb _ '|' True = Set1
comb x '^' False = x
comb x '^' True = neg x
comb _ '&' False = Set0
comb x '&' True = x

solve :: [(Char, Int)] -> (Int, Int, Int)
solve os = foldl' (\s@(!a, !o, !x) (i, c) -> case c of { Id -> s; Neg -> (a, o, x `setBit` i); Set0 -> (a `clearBit` i, o, x); Set1 -> (a, o `setBit` i, x) }) (1023, 0, 0) $ zip [0..] $ foldl' (\cs (o, n) ->  zipWith (\i c -> comb c o (n `testBit` i) :: Op) [0..] cs) (replicate 10 Id) os

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE DeriveGeneric, BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Bits
import GHC.Generics
import Control.DeepSeq

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  (\(a, o, x) -> "3\n& " ++ show a ++ "\n| " ++ show o ++ "\n^ " ++ show x) `fmap` solve `fmap` replicateM n (liftM2 (\a b -> (B.head a, b)) pop poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

data Op = Id | Neg | Set0 | Set1 deriving (Show, Generic)
instance NFData Op
neg Neg = Id
neg Id = Neg
neg Set0 = Set1
neg Set1 = Set0

comb x '|' False = x
comb _ '|' True = Set1
comb x '^' False = x
comb x '^' True = neg x
comb _ '&' False = Set0
comb x '&' True = x

solve :: [(Char, Int)] -> (Int, Int, Int)
solve os = foldl' (\s@(!a, !o, !x) (i, c) -> case c of { Id -> s; Neg -> (a, o, x `setBit` i); Set0 -> (a `clearBit` i, o, x); Set1 -> (a, o `setBit` i, x) }) (1023, 0, 0) $ zip [0..] $ foldl' (\cs (o, n) -> force $ zipWith (\i c -> comb c o (n `testBit` i) :: Op) [0..] cs) (replicate 10 Id) os

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

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

main :: IO ()
main = do
    n <- readInt <$> C.getLine
    xs <-  map C.words <$> replicateM n C.getLine
    let ans = solve xs
    print $ length ans
    putStrLn $ unlines ans

readInt = fst . fromJust . C.readInt

solve xs = gen $ foldl run [0, 1023] xs

run ps (c:x:_) | c == "&" = map (.&. v) ps
               | c == "|" = map (.|. v) ps
               | c == "^" = map (xor v) ps
               where v = readInt x

gen :: [Int] -> [String]
gen [a,b] = ["& " ++ show ((xor a 1023 .&. b) .|. (a .&. xor b 1023))
            ,"^ " ++ show (a .&. xor b 1023)
            ,"| " ++ show (a .&. b)
            ]

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

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

main :: IO ()
main = do
    n <- readInt <$> C.getLine
    xs <-  map C.words <$> replicateM n C.getLine
    let ans = solve xs
    print $ length ans
    putStrLn $ unlines ans

readInt = fst . fromJust . C.readInt

solve xs = gen $ foldl run [0, 1023] xs

run ps (c:x:_) | c == "&" = map (.&. v) ps
               | c == "|" = map (.|. v) ps
               | c == "^" = map (xor v) ps
               where v = readInt x

gen :: [Int] -> [String]
gen [a,b] = ["& " ++ show (xor a 1023 .&. b)
            ,"| " ++ show (a .&. b)
            ,"^ " ++ show (a .&. xor b 1023)
            ]

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

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

main :: IO ()
main = do
    n <- readInt <$> C.getLine
    xs <-  map C.words <$> replicateM n C.getLine
    let ans = solve xs
    print $ length ans
    putStrLn $ unlines ans

readInt = fst . fromJust . C.readInt

solve xs = gen $ foldl run [0, 1023] xs

run ps (c:x:_) | c == "&" = map (.&. v) ps
               | c == "|" = map (.|. v) ps
               | c == "^" = map (xor v) ps
               where v = readInt x

gen :: [Int] -> [String]
gen [a,b] = ["| " ++ show (a .&. b)
            ,"& " ++ show (xor a 1023 .&. b)
            ,"^ " ++ show (a .&. xor b 1023)
            ]

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

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

main :: IO ()
main = do
    n <- readInt <$> C.getLine
    xs <-  map C.words <$> replicateM n C.getLine
    let ans = solve xs
    print $ length ans
    putStrLn $ unlines ans

readInt = fst . fromJust . C.readInt

solve xs = gen $ foldl run [0, 1023] xs

run ps (c:x:_) | c == "&" = map (.&. v) ps
               | c == "|" = map (.|. v) ps
               | c == "^" = map (xor v) ps
               where v = readInt x

gen :: [Int] -> [String]
gen [a,b] = ["& " ++ show (xor a 1023 .&. b)
            ,"^ " ++ show (a .&. xor b 1023)
            ,"| " ++ show (a .&. b)
            ]


import           Control.Monad
import           Data.Function
import           Data.Functor
import           Data.List
main :: IO ()
main = do
    n <- getLine <&> read :: IO Int
    replicateM_ n $ do
        l <- getLine <&> read :: IO Int
        s <- getLine
        let g = group s
        length g & (`div` 2) & (g !!) & length & print
        return ()

module Main (main)
where

import           Data.List (intercalate)
import           System.IO (IO (..))

type Case = (Int, String)

main :: IO ()
main = intercalate "\n" <$> map show <$> map solve <$> (read <$> getLine >>= readNCases) >>= putStrLn

readNCases :: Int -> IO [Case]
readNCases n = sequence $ replicate n readOneCase

readOneCase :: IO Case
readOneCase = (\[a, b] -> (read a, b)) <$> (sequence $ replicate 2 getLine)

solve :: Case -> Int
solve (n, str)
  | odd n = (solve' $ reverse (take ((n + 1) `div` 2) str)) * 2 - 1
  | otherwise = (solve' $ reverse $ take (n `div` 2) str) * 2

solve' :: [Char] -> Int
solve' [] = 0
solve' [x] = 1
solve' (x:y:xs) = if (x == y) then 1 + solve' (y:xs) else 1

-- https://codeforces.com/contest/1679/problem/D
{-# 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.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.Maybe (fromJust, fromMaybe, isJust)

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 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 :: B8.ByteString -> Int
solve str = L.length middleGroup
  where
    groups = L.group $ B8.unpack str
    middleGroup = groups L.!! (L.length groups `div` 2)

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


import Control.Monad
import Data.Array.IO
import Data.IORef

main :: IO ()
main = do
    nAndQ <- (map (read :: String -> Int) . words) <$> getLine
    let n = nAndQ !! 0
        q = nAndQ !! 1
    arr <- newArray (1, n) 0 :: IO (IOArray Int Int)
    ns <- (map (read :: String -> Int) . words) <$> getLine
    count <- newIORef 0
    forM (zip [1..] ns) $ \(i, v) -> do
        writeArray arr i v
        modifyIORef count (if v == 1 then (+1) else id)
    forM [1..q] $ \_ -> do
        tv <- (map (read :: String -> Int) . words) <$> getLine
        let t = tv !! 0
            v = tv !! 1
        if t == 1 then do
            x <- readArray arr v
            writeArray arr v (1 - x)
            modifyIORef count (if x == 0 then (+1) else (\a -> a - 1))
        else do
            c <- readIORef count
            print $ if v <= c then 1 else 0
    pure ()

{-# LANGUAGE Safe #-}

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

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

import Data.Array.IO.Safe

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q] <- readInts
  aLi <- readInts
  a <- lift (newListArray (1, n) aLi :: IO (IOUArray Int Int))
  let
    step ct () = do
      [t, x] <- readInts
      if  t == 2
        then  do
          ct <$ putInts [if  ct >= x  then  1  else  0]
        else  lift $ do
          v <- readArray a x
          (ct + 1 - 2*v) <$ writeArray a x (1-v)
  foldM_ step (foldl' (+) 0 aLi) (replicate q ())

type SIO = StateT P.ByteString IO

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

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

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


--ghc 7.10

import Data.Bits((.|.))

countFloorNonsleeping :: [Int] -> Int
countFloorNonsleeping (x:y:ys) = (x .|. y) + countFloorNonsleeping ys
countFloorNonsleeping _ = 0

countBuldingNonsleeping :: [[Int]] -> Int
countBuldingNonsleeping = sum . map countFloorNonsleeping

main = do
    nmStr <- getLine
    contents <- getContents
    let xss = map (map read . words) . lines $ contents
    print $ countBuldingNonsleeping xss

import Control.Monad
import Control.Applicative
import Data.List.Split

main :: IO ()
main = do
    flats <- drop 1 . chunksOf 2 . map (read::String->Int) . words <$> getContents
    print . length . filter (> 0) $ map sum flats

import Control.Applicative
import Control.Monad

solve :: [Int] -> Int
solve [] = 0
solve (x:y:ys) = signum (x + y) + solve ys

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

import Control.Applicative
import Data.List

process n [] = n
process n (a:b:s) = process (if a+b>0 then (n+1) else n) s

main= do
	getLine
	s<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	print $ sum $ map (process 0) s

module Main where

-- A

split :: Char -> String -> [String]
split _ [] = [""]
split c (x:xs) | x == c = "" : rest
               | otherwise  = (x : head rest): tail rest
                where rest = split c xs

solution :: [String] -> Int -> Int
solution stringFloors roomsAmount =
    let
        floors = map (\line -> map read (split ' ' line) :: [Int]) stringFloors
        countWake = \floor -> sum [if floor !! (i*2) == 1 || floor !! (i*2+1) == 1 then 1 else 0 |i <- [0..roomsAmount - 1]]
    in
        sum (map countWake floors)

main = getLine >>=
    \houseParamsString ->
        let
            houseParamsList = map read (split ' ' houseParamsString) :: [Int]
            floorsAmount = houseParamsList !! 0
            rooms = houseParamsList !! 1
        in
            sequence (replicate floorsAmount getLine) >>=
                \floors ->
                    putStrLn $ show (solution floors rooms)

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

solve :: [Int] -> Int
solve [] = 0
solve (a:b:x) = let rest = solve x
                in if a == 0 && b == 0 then rest else 1 + rest

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

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

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

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

  let
    f [] = 0
    f (a:b:xs) = (if a == 1 || b == 1 then 1 else 0) + f xs

  print $ sum $ map f ls

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
main = do
  [n,m] <- readLists
  a <- readMatrix
  print $ sum $ [num|a0 <-a,let num = length $ filter (1<=) $ zipWith (+) [at|(it,at)<-zip [0..] a0,(mod it 2) == 0] [at|(it,at)<-zip [0..] a0,(mod it 2) == 1]]

main = interact $ show . f . map read . words
f (a:b:c) = f1 c
f1 [] = 0
f1 (0:0:a) = f1 a
f1 (a:b:c) = 1 + f1 c

main = interact $ show . length . filter (> 0) . map (uncurry (+)) . pairs . map read . drop 2 . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []

module Main where

import Data.Functor

main :: IO ()
main = do
   [rn,cn] <- words <$> getLine
   mx <- getMatrix (read rn) (2 * read cn)
   print $ calc mx

getMatrix :: Int -> Int -> IO [[Int]]
getMatrix rn cn = do
   rows <- take rn <$> lines <$> getContents
   return $ map (map read . take cn . words) rows

calc :: [[Int]] -> Int
calc = sum . map group2

group2 :: [Int] -> Int
group2 [] = 0
group2 (0:0:as) = 0 + group2 as
group2 (0:1:as) = 1 + group2 as
group2 (1:0:as) = 1 + group2 as
group2 (1:1:as) = 1 + group2 as
group2 _ = undefined


import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array
import qualified Data.ByteString.Char8 as BS

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

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

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> snd $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst $ ans ! c)) * 2 <= weight
                         then c
                         else lift (pa ! c)

-- Codeforces 686D

{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -optc-O0 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (2, n) xs :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            !szu <- readArray son u
            !szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        su <- readArray son u
                        r <- readArray centeroid maxv
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array
import qualified Data.ByteString.Char8 as BS

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

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

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> snd $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

updateArray a i f = do
    v <- readArray a i
    writeArray a i (f v)

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> updateArray graph pi (i:)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid
                 | children == [] || (fst fat) * 2 <= weight = v
                 | otherwise = lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c
                 | (weight - (fst $ ans ! c)) * 2 <= weight = c
                 | otherwise = lift (pa ! c)

-- Codeforces 686D

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (2, n) xs :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            !szu <- readArray son u
            !szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        su <- readArray son u
                        r <- readArray centeroid maxv
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Array as A

main = interact $ unlines . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = A.array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (baricenter, weight)
          where baricenter = if children == [] || (snd fat) * 2 <= weight
                             then v
                             else lift $ fst fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map snd children)
                lift c = if (weight - (snd (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

-- Codeforces 686D

{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -optc-O0 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (1, n) (0:xs) :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          -- dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            szu <- readArray son u
            szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        r <- readArray centeroid maxv
                        su <- readArray centeroid u
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

main = interact $ unlines . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

main = interact $ unlines . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (baricenter, weight)
          where baricenter = if children == [] || (snd fat) * 2 <= weight
                             then v
                             else lift $ fst fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map snd children)
                lift c = if (weight - (snd (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

main = interact $ unlines . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:q:rest) = if n < 1000 then map (\i -> snd $ all ! i) queries else queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

main = interact $ unlines . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:q:rest) = if n < 1000 then map (\i -> snd $ all ! i) queries else map (\v->if v==[] then 0 else head v) $ elems graph
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)


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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th==0 = cost+m*x
        | otherwise = min (cost+m*x) ((m+th-1)`div`th*cost)
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

gao n [] = 0
gao n (a:b:x:y:t) = s + r
  where
    c = b - a
    m = (n + c - 1) `div` c
    r = gao n t
    s
      | c <= 0    = x * n + y
      | m == 1    = y
      | otherwise = minimum [x * n + y, m * y, (n - (m - 2) * c) * x + (m - 1) * y]

main = do
  (n:m:a) <- fmap (map (fromIntegral . fst . fromJust . C.readInt) . C.words) C.getContents
  print $ gao m a

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

gao n [] = 0
gao n (a:b:x:y:t) = s + r
  where
    c = b - a
    m = (n + c - 1) `div` c
    r = gao n t
    s
      | c <= 0    = x * n + y
      | m == 1    = y
      | otherwise = minimum [x * n + y, m * y, (n - (m - 2) * c) * x + (m - 1) * y]

main = do
  (n:m:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  print $ gao m a

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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | m<=th = cost
        | th*x<=cost = cost + m*x
        | otherwise = ((m+th-1)`div`th)*cost
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th>m = cost
        | th*x < cost = m*x+cost
        | otherwise = q*cost + min cost (r*x)
       where
         th = max 0 $ tt-t
         (q,r) = divMod m th
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th==0 = cost+m*x
        | m<=th = cost
        | (th+r)*x<=cost = cost + m*x
        | otherwise = q*cost
       where
         th = max 0 $ tt-t
         (q,r) = divMod (m+th-1) th
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

readInteger bs = case B.readInteger bs of Just (n,_) -> n

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | cost-th*x>=0 = m*x+cost
        | otherwise = ((m+th-1)`div`th)*cost
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words


{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}

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.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.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

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

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

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

solve :: Int -> B8.ByteString -> [Int]
solve n directions = do
        -- traceShowM nextRLs
        -- traceShowM prevRLs
        i <- [0 .. n]
        let nextRL = nextRLs UA.! (i + 1)
        let prevRL = prevRLs UA.! i
        return $ prevRL + 1 + nextRL
    where
        nextRLs :: UA.UArray Int Int
        nextRLs = STA.runSTUArray $ do
            dpRL <- STA.newArray (0, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            dpLR <- STA.newArray (0, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ (reverse [1 .. n]) $ \i -> do
                nextDpLR <- STA.readArray dpLR (i + 1)
                nextDpRL <- STA.readArray dpRL (i + 1)

                let lengthLR = if (directions `B8.index` (i - 1)) == 'L' then 1 + nextDpRL else 0
                    lengthRL = if (directions `B8.index` (i - 1)) == 'R' then 1 + nextDpLR else 0

                STA.writeArray dpLR i lengthLR
                STA.writeArray dpRL i lengthRL
            return dpRL

        prevRLs :: UA.UArray Int Int
        prevRLs = STA.runSTUArray $ do
            dpRL <- STA.newArray (-1, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            dpLR <- STA.newArray (-1, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ [1 .. n] $ \i -> do
                prevDpLR <- STA.readArray dpLR (i - 1)
                prevDpRL <- STA.readArray dpRL (i - 1)

                let lengthLR = if (directions `B8.index` (i - 1)) == 'R' then 1 + prevDpRL else 0
                    lengthRL = if (directions `B8.index` (i - 1)) == 'L' then 1 + prevDpLR else 0

                STA.writeArray dpLR i lengthLR
                STA.writeArray dpRL i lengthRL
            return dpRL

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        directions <- B8.getLine <&> head . B8.words

        let answer = solve n directions

        forM_ answer $ printf "%d "
        printf "\n"

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  _ <- getLine
  s <- getLine
  let bs = group $ zipWith (\c i -> (c == 'L') == even i) s [0 :: Integer ..]
  let xs = bs >>= (\a -> replicate (length a) (length a, head a))
  let cs =
        zipWith3
          ( \(x1, b1) (x2, b2) i ->
              if even i
                then
                  ( if b1 && b2 then 1 else if b1 then 1 + x2 else 1 + x1
                  )
                else
                  ( if b1 then 1 + x1 else if b2 then 1 + x2 else 1
                  )
          )
          (head xs : xs)
          (xs ++ [last xs])
          [0 :: Integer ..]
  putStrLn $ unwords $ show <$> cs

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    s <- readLine
    let
      evens = P.cycle $ P.pack "RL"
      evenStops = [i | (i, p) <- zip [0..] $ P.zipWith (/=) evens s, p] ++ [n]
      oddStops  = [i | (i, p) <- zip [0..] $ P.zipWith (==) evens s, p] ++ [n]
      step :: Int -> Int -> [Int] -> [(Int, Int)]
      step ix last li@(next:nexts)
        | ix > next  = step ix next nexts
        | otherwise  = (ix, next-last) : step (ix+2) last li
      step _ _ [] = []
      ans0 = step 0 (-1) evenStops
      ans1 = step 1 (-1) oddStops
      ans = map snd . sort $ ans0 ++ ans1
    lift . P.putStrLn . P.pack . unwords $ map show ans

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  _ <- getLine
  s <- getLine
  let bs = group $ zipWith (\c i -> (c == 'L') == even i) s [0 :: Integer ..]
  let xs = bs >>= (\a -> replicate (length a) (length a, head a))
  print xs
  let cs =
        zipWith3
          ( \(x1, b1) (x2, b2) i ->
              if even i
                then
                  ( if b1 && b2 then 1 else if b1 then 1 + x2 else 1 + x1
                  )
                else
                  ( if b1 then 1 + x1 else if b2 then 1 + x2 else 1
                  )
          )
          (head xs : xs)
          (xs ++ [last xs])
          [0 :: Integer ..]
  print cs


import qualified Data.Map as Map
import Data.List
import Data.Maybe

adj::[String] -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where rows = length graph
        cols = length $ head graph
        getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Map.Map String Bool -> Map.Map String Bool
mark r c  = Map.insert (getNodeKey r c) True

hasCycle::[String] -> Bool
hasCycle graph = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Map.empty

findCycle::[String] -> (Char, Int, Int) -> (Char, Int, Int) -> Map.Map String Bool -> Bool
findCycle graph current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if isNothing $ Map.lookup (getNodeKey r c) marked
      then findCycle graph v current (mark r c marked)
      else v /= parent
    ) $ adj graph current

readLine = getLine >>= return . words

main = do
  _ <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph then "Yes" else "No"

module Main where

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- replicateM n getLine
  B.putStrLn . B.pack $ main' n m $ concat field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = fst $ foldl check (False, []) [0..length str]
  where
    check (True, _) _ = (True, [])
    check (False, visited) ind
      | ind `elem` visited = (False, visited)
      | otherwise = (fst res, snd res ++ visited)
        where res = dfs ind Nothing [] (n,m, str)

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> (Bool, [Int])
dfs ind prev visited g@(h, w, graph)
  | ind >= length graph = (False, visited)
  | ind `elem` visited = (True, visited)
  | null sub' = (False, ind:visited)
  | otherwise = (or $ fst m', concat $ snd m')
  where
    sub = getSubNodes g ind
    sub' = case prev of
      Nothing -> sub
      Just x -> filter (/= x) sub
    m' = unzip $ map (\i -> dfs i (Just ind) (ind:visited) g) sub'

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(h, w, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> and [x >= 0, x < (length str), str!!x == str!!ind])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, fromMaybe)
import Data.Set (member, insert, empty, Set)
import Data.Map.Strict (lookup, fromList, toList, (!), Map, keys)
import Data.List (concatMap)
import Prelude hiding (lookup)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

neighbours :: (Int, Int) -> [(Int, Int)]
neighbours (x, y) =
  [ (x - 1, y)
  , (x, y - 1)
  , (x + 1, y)
  , (x, y + 1)
  ]

dfs :: Map (Int, Int) Char -> Set (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> (Bool, Set (Int, Int))
dfs field visited point prev =
  if member point visited then
    (True, visited)
  else
    let
      getPair k m =
        case lookup k m of
          Just v -> [(k, v)]
          Nothing -> []
      candidates =
        filter (fromMaybe (const True) $ fmap (/=) prev)
        . map fst
        . filter ((== field ! point) . snd)
        . concatMap (flip getPair field)
        . neighbours
        $ point
      folder res@(True, _) _ = res
      folder (_, visited) candidate =
        dfs field visited candidate (Just point)
    in
      foldl folder (False, insert point visited) candidates

reduce :: Map (Int, Int) Char -> Set (Int, Int) -> [(Int, Int)] -> Bool
reduce field visited [] = False
reduce field visited (point:points) =
  if member point visited then
    reduce field visited points
  else
    let (res, newVisited) = dfs field visited point Nothing
    in if res then res else reduce field newVisited points

main = do
  [rows, columns] <- readLine
  field <- sequence (take rows . repeat $ B.getLine >>= return . B.unpack) >>=
             return . fromList . concatMap (\(x, row) -> zipWith (\y ch -> ((x, y), ch)) [0..] row) . zip [0..]
  B.putStrLn . B.pack $ if reduce field empty (keys field) then "Yes" else "No"

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, catMaybes, fromMaybe)
import Data.Map (Map, lookup, insert, empty, union)
import Prelude hiding (lookup)
-- import Debug.Trace (traceShowId)

folder :: (Bool, Int, Map Int Int, (Char, Int), Map Int Int, [(Char, Int)]) -> (Char, (Char, Int)) -> (Bool, Int, Map Int Int, (Char, Int), Map Int Int, [(Char, Int)])
folder all@(res, nextId, mappings, (prevChar, prevGroup), nextMappings, collected) next@(nextChar, (prevLineChar, prevLineGroup)) =
  if res then -- fst . traceShowId $ (res, (all, next)) then
    all
  else
    if prevChar == nextChar then
      if (== prevGroup) . fromMaybe prevLineGroup $ lookup prevLineGroup mappings then
        (True, nextId, mappings, (nextChar, prevGroup), nextMappings, (nextChar, prevGroup):collected)
      else
        if prevChar == prevLineChar then
          let
            prevLineGroupMapping = lookup prevLineGroup mappings
            basePrevLineGroupMapping =
              prevLineGroupMapping >>= flip lookup nextMappings
            finalPrevLineGroupMapping =
              case basePrevLineGroupMapping of
                Just _ -> basePrevLineGroupMapping
                Nothing -> prevLineGroupMapping
          in
            ( False
            , nextId
            , insert prevLineGroup prevGroup mappings
            , (nextChar, prevGroup)
            , case basePrevLineGroupMapping of
                Just x -> insert prevGroup x nextMappings
                _ -> nextMappings
            , (nextChar, prevGroup):collected
            )
        else
          (False, nextId, mappings, (nextChar, prevGroup), nextMappings, (nextChar, prevGroup):collected)
    else
      if prevLineChar == nextChar then
        let new = (nextChar, fromMaybe prevLineGroup $ lookup prevLineGroup mappings)
        in (False, nextId, mappings, new, nextMappings, new:collected)
      else
        (False, nextId + 1, mappings, (nextChar, nextId), nextMappings, (nextChar, nextId):collected)

outerFolder :: (Bool, Int, Map Int Int, [(Char, Int)]) -> [Char] -> (Bool, Int, Map Int Int, [(Char, Int)])
outerFolder all@(res, nextId, mappings, prevLine) line =
  if res then
    all
  else
    let
      (newRes, newNextId, oldMappings, _, newMappings, newLine) =
        foldl folder (False, nextId, mappings, ('$', -1), empty, []) $ zip line prevLine
    in
      (newRes, newNextId, union newMappings oldMappings, reverse newLine)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  field <- sequence . take rows $ repeat (B.getLine >>= return . B.unpack)
  B.putStrLn . B.pack $
    case foldl outerFolder (False, 0, empty, take cols $ repeat ('$', -1)) field of
      (True, _, _, _) -> "Yes"
      _ -> "No"

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

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

  let
    a' = listArray ((1, 1), (n, m)) $ concat a :: Array (Int, Int) Char

    f = or $ (flip evalState) Set.empty $ do
      forM ((,) <$> [1..n] <*> [1..m]) $ \v -> do
        m <- get
        if v `Set.member` m
           then return False
           else search (0, 0) v

    adj xy@(x, y) = filter (\xy'@(x, y) -> elem x [1..n] && elem y [1..m] && a'!xy' == a'!xy) [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

    search w u = do
      modify $ Set.insert u

      or <$> (forM (adj u) $ \v -> do
        m <- get
        if v `Set.member` m
         then return $ v /= w
         else search u v)

  putStrLn $ if f then "Yes" else "No"

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

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

  let
    a' = listArray ((1, 1), (n, m)) $ concat a :: Array (Int, Int) Char

    f = or ((flip evalState) Set.empty $ do
      forM ((,) <$> [1..n] <*> [1..m]) $ \v -> do
        m <- get
        if v `Set.member` m
           then return False
           else search (0, 0) v)

    adj xy@(x, y) = filter (\xy'@(x, y) -> 1 <= x && x <= n && 1 <= y && y <= m && a'!xy' == a'!xy) [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

    search w u = do
      modify $ Set.insert u

      or <$> (forM (adj u) $ \v -> do
        m <- get
        if v `Set.member` m
         then return $ v /= w
         else search u v)

  putStrLn $ if f then "Yes" else "No"

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

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Set.Set String -> Set.Set String
mark r c  = Set.insert (getNodeKey r c)

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Set.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Set.Set String -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if Set.notMember (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

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

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Map.Map String Bool -> Map.Map String Bool
mark r c  = Map.insert (getNodeKey r c) True

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Map.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Map.Map String Bool -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if isNothing $ Map.lookup (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

import qualified Data.Map as Map
import Data.List
import Data.Maybe

adj::[String] -> (Int, Char) -> [(Int, Char)]
adj graph (i, v)
  | i > maxLength - 1 || i < 0 = []
  | otherwise = filter (\(_, x) -> x == v)
      $ map node
      $ filter (\x -> x >= 0 && x < maxLength)
        [
          if hasPrev i then i - 1 else -1,
          if hasNext i then i + 1 else -1,
          i - cols,
          i + cols
        ]
  where rows = length graph
        cols = length $ head graph
        maxLength = cols * rows
        hasPrev index = col index > 0
        hasNext index = col index < cols - 1
        row index =  floor (fromIntegral index / fromIntegral cols)
        col index = index - cols * row index
        node index = (index, (graph !! row index) !! col index)

hasCycle graph =
  isJust $ find (\node -> findCycle graph node node (Map.insert (fst node) True marked))
    $ zip [0..] (intercalate "" graph)
  where marked = Map.empty

findCycle::[String] -> (Int, Char) -> (Int, Char) -> Map.Map Int Bool -> Bool
findCycle graph current parent marked =
  isJust $ find (\node ->
    if isNothing $ Map.lookup (fst node) marked
      then findCycle graph node current (Map.insert (fst node) True marked)
      else node /= parent
    ) $ adj graph current

readLine = getLine >>= return . words

main = do
  _ <- readLine
  graph <- getContents >>= return . words
  print $ if hasCycle graph then "Yes" else "No"

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

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Set.Set String -> Set.Set String
mark r c  = Set.insert (getNodeKey r c)

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Set.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Set.Set String -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if Set.member (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

module Main where

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- replicateM n getLine
  B.putStrLn . B.pack $ main' n m $ concat field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = any (\ind -> dfs ind Nothing [] (n,m, str)) [1..length str]

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> Bool
dfs ind prevInd visitedInd g@(w, h, graph)
  | ind >= length graph = False
  | ind `elem` visitedInd = True
  | null sub' = False
  | otherwise = or $ map (\i -> dfs i (Just ind) (ind:visitedInd) g) sub'
  where
    sub = getSubNodes g ind
    sub' = case prevInd of
      Nothing -> sub
      Just x -> filter (/= x) sub

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(w, h, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> str!!x == str!!ind) . filter (\x -> and [x /= ind, x >= 0, x < (length str)])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w

module Main where

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- getContents
  B.putStrLn . B.pack $ main' n m $ field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = any (\ind -> dfs ind Nothing [] (n,m, str)) [1..length str]

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> Bool
dfs ind prevInd visitedInd g@(w, h, graph)
  | ind >= length graph = False
  | ind `elem` visitedInd = True
  | null sub' = False
  | otherwise = or $ map (\i -> dfs i (Just ind) (ind:visitedInd) g) sub'
  where
    sub = getSubNodes g ind
    sub' = case prevInd of
      Nothing -> sub
      Just x -> filter (/= x) sub

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(w, h, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> str!!x == str!!ind) . filter (\x -> and [x /= ind, x >= 0, x < (length str)])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w


diff :: String -> String -> Int
diff [] [] = 0
diff as bs | head as == head bs = 1 + diff (tail as) (tail bs)
           | otherwise          = 0

dafuq x = do
            let c = tail $lines x
            show.minimum.map (diff (head c)) $c

main = interact dafuq

main = do getContents >>= print . length . takeWhile (/='*') . foldl1 (zipWith (\i j -> if i == j then i else '*')) . tail . lines

import Data.List
commonPrefix :: [String] -> Int
commonPrefix = length . commonPart
    where commonPart = foldl1' step
              where step acc x = map fst . takeWhile (\(i,j) -> i == j) . zip acc $ x

main = interact $ show . commonPrefix . tail .  lines

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

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

hoge 'R' = 0
hoge 'P' = 1
hoge 'S' = 2

wins x y | a == b = False
         | (a - b) `mod` 3 == 1 = True
         | otherwise = False
  where
    (a, b) = (hoge x, hoge y)

play m ns ps = play' m 0 0 ns ps
  where
    play' 0 a b _  _  = (a, b)
    play' x a b (n:ns) (p:ps) | wins n p = play' (x - 1) a (b+1) ns ps
                              | wins p n = play' (x - 1) (a + 1) b ns ps
                              | otherwise = play' (x - 1) a b ns ps

longest as bs = longest' [] as bs
  where
    longest' stack (x:xs) (y:ys) | x == y = longest' (x:stack) xs ys
    longest' stack _ _ = reverse stack

loop _ []  = return 0
loop 0 lst = return $ length lst
loop n lst = do s <- readTerm
                let l = longest lst s
                loop (n - 1) l

main = do n <- readNum
          s <- readTerm
          l <- loop (n - 1) s
          print $ l

main = do
    numbers <- fmap (tail . lines) getContents
    print $ length $ foldl1 commonPrefix numbers
    where
        commonPrefix _      ""     = ""
        commonPrefix ""     _      = ""
        commonPrefix (x:xs) (y:ys) = if x == y then x:commonPrefix xs ys else ""

import qualified Data.List as L
main = interact $ show . solve . tail . words
solve s = length . takeWhile (\xs -> all (== head xs) xs) . L.transpose $ s

calc2 (x:a) (y:b)
    | x == y = (x:calc2 a b)
    | otherwise = []
calc2 _ _ = []

main = do
    contents <- getContents
    print $ length $ foldl1 calc2 (tail $ lines contents)

calc2 :: Eq a => [a] -> [a] -> [a]
calc2 (x:a) (y:b)
    | x == y = (x:calc2 a b)
    | otherwise = []
calc2 _ _ = []

calcn (x:y:xs) = calcn z
    where
        z = [calc2 x y] ++ xs
calcn (x:[]) = x

main = do
    contents <- getContents
    print $ length $ calcn $ tail $ lines contents

import Control.Applicative
import Data.List

solve :: [String] -> Int
solve d = if all ((d !! 0 !! 0 : []) `isPrefixOf`) d
          then 1 + (solve $ map (drop 1) d)
          else 0

main :: IO ()
main = do
  n <- getLine
  d <- words <$> getContents
  print $ solve d

getPrefix :: String -> String -> String
getPrefix [] _  =  []
getPrefix _ []  =  []
getPrefix (c1:s1) (c2:s2)
  | c1 == c2  =  c1 : getPrefix s1 s2
  | otherwise  =  []

main :: IO ()
main  =  do
    n <- readLn
    lines <- mapM (const getLine) [1..n]
    print $ length (foldl1 getPrefix lines)

import System.IO

readInputLoop :: Int -> IO [String]
readInputLoop 0 = do
    return []

readInputLoop n = do
     h <- getLine
     t <- readInputLoop (n - 1)
     return $ h:t

readInput :: IO [String]
readInput = do
    n_str <- getLine
    readInputLoop (read n_str::Int)

-- I don't care about tail recursion
lcp :: [String] -> Int
lcp list   | any null list                                        = 0
           | any (\str -> ((head str) /= head (head list))) list  = 0
           | otherwise                                            = 1 + (lcp $ map (drop 1) list)

main :: IO()
main = do
    x <- readInput
    putStrLn $ show $ lcp x

main = print . length . foldr1 commonPrefix . tail . lines =<< getContents
commonPrefix (a:as) (b:bs) | a == b    = a : commonPrefix as bs
commonPrefix _ _ = []

import Control.Monad
import Data.List
main = do
    n <- fmap read getLine
    s <- forM [1..n] (\_ -> getLine)
    print $ solve s 0
solve :: [String] -> Integer -> Integer
solve s n = if allEq $ map (genericTake $ n+1) s then solve s $ n+1 else n
allEq :: [String] -> Bool
allEq [] = True
allEq [x] = True
allEq (x:y:ys) = x == y && allEq (y:ys)

import Data.Functor

allEqual :: Eq a => [a] -> Bool
allEqual l = all (== head l) l

-- | Find longest common prefix size for strings of equal length.
prefixLen :: [String] -> Int
prefixLen species@(s:_) =
    let
        prefixes = map head species
    in
      if (length s /= 0) && (allEqual prefixes) then
          1 + (prefixLen $ map tail species)
      else 0

main :: IO ()
main = do
  -- read n (assume n ≥ 2)
  _ <- getLine
  numbers <- lines <$> getContents
  print $ prefixLen numbers

import Data.List
solve = length . takeWhile (((==) 1) . length . group) . transpose
parse = tail . lines
main = interact (show . solve . parse)


main = getContents >>= print.p. map (\x -> (map (\y -> read y :: Integer)).words $x).lines
	where
		p [[x1, y1, r1], [x2, y2, r2]]
		 | r1^2 < d && r2^2 < d && (r1 + r2)^2 >= d = 0
		 | (r1 + r2)^2 < d = (sqrt(fromIntegral d) - (fromIntegral r1) - (fromIntegral r2))/2.0
		 | (r1 + r2)^2 >= d && (r1 - r2)^2 <= d = 0
		 | True = (rr1 - dd - rr2)/2.0
		 | otherwise = error "out of bound"
		 where
		 	rr1 = fromIntegral $ max r1 r2
			rr2 = fromIntegral $ min r1 r2
			d = (x1 - x2)^2 + (y1 - y2)^2
			dd = sqrt $ fromIntegral d

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    (/ 2) . abs $ (dist p0 p1) - r0 - r1

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d > r0 + r1  = outside (p0, r0) (p1, r1)
    | d <= r0 + r1 && d + small >= big = 0
    | d + small < big = inside (p0, r0) (p1, r1)
    where
      small = min r0 r1
      big = max r0 r1
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

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

{-
import HUnit

eps  =  1e-06

testZero  =  Test "TestZero" $
    assertApproximate 0.0 (solve (0,0,1) (2,0,1)) eps

testInput1  =  Test "TestInput1" $
    assertApproximate 1.0 (solve (0,0,1) (6,0,3)) eps

testInput2  =  Test "TestInput2" $
    assertApproximate 11.142135623730951 (solve (-10,10,3) (10,-10,3)) eps

testInside  =  Test "TestInside" $
    assertApproximate 1.0 (solve (0,0,1) (0,0,3)) eps

testIntersect  =  Test "TestIntersect" $
    assertApproximate 0.0 (solve (0,0,1) (0,1,1)) eps

test  =  mapM_ run
  [
    testZero,
    testInput1,
    testInput2,
    testInside,
    testIntersect
  ]
-}
--------------------------------------------------------------------------------

solve :: (Double, Double, Double) -> (Double, Double, Double) -> Double
solve (x1, y1, r1) (x2, y2, r2)
  | d > r1 + r2  =  0.5 * (d - (r1 + r2))
  | d < max r1 r2 - min r1 r2  =  0.5 * (max r1 r2 - d - min r1 r2)
  | otherwise  =  0
  where
    d  =  sqrt ((x2-x1) * (x2-x1) + (y2-y1) * (y2-y1))

main :: IO ()
main  =  do
    [[x1, y1, r1], [x2, y2, r2]]  <-  mapM (const (getLine >>= return . map read . words)) [1,2]
    print $ solve (x1,y1,r1) (x2,y2,r2)

import System.IO
import Text.Printf
data Point = Point Double Double deriving (Show)
data Circle = Circle Point Double deriving (Show)

distance :: Point -> Point -> Double
distance ( Point x1 y1 ) (Point x2 y2) = sqrt $ (x1-x2)^2+(y1-y2)^2
r120d2b :: Circle -> Circle -> Double
r120d2b ( Circle ( Point x1 y1 ) r1 ) ( Circle ( Point x2 y2 ) r2)
        | d > rplusr = ( d - rplusr ) / 2
        | d < rminusr = ( abs(r2-r1) - d) / 2
        | otherwise = 0
        where rminusr = (max r2 r1) - ( min r2 r1)
              rplusr = r2 + r1
              d = distance (Point x1 y1 ) ( Point x2 y2)

makePoint :: Double -> Double -> Point
makePoint a b = (Point a b )
makeCircle :: Point -> Double -> Circle
makeCircle (Point a b ) c = (Circle (Point a b ) c )

rDouble :: String -> Double
rDouble = read

main = do
    line <- getLine
    let b = (map  rDouble ) ( words line)
    let c1 = makeCircle ( makePoint ( b !! 0 ) (b !! 1) ) ( b !! 2)
    line <- getLine
    let b = (map  rDouble ) ( words line)
    let c2 = makeCircle ( makePoint ( b !! 0 ) (b !! 1) ) ( b !! 2)
    printf "%0.8f\n" (r120d2b c1 c2 )

main = getContents >>= print.p. map (\x -> (map (\y -> read y :: Double)).words $x).lines
	where
		p [[x1, y1, r1], [x2, y2, r2]] = if (r1 + r2) ^ 2  >= (x1-x2)^2 + (y1-y2) ^2  then 0 else if r1 + r2 <= d then (d-r1-r2)/2 else 0
			where
				d = (sqrt $ ((x1 - x2)^2 + (y1 - y2)^2))

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    (/ 2) . abs $ (dist p0 p1) - r0 - r1

intersect (p0, r0) (p1, r1) =
    abs $ (r1 + r0 - (dist p0 p1)) / 2

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d > r0 + r1   = outside (p0, r0) (p1, r1)
    | d < max r0 r1 = inside (p0, r0) (p1, r1)
    | otherwise     = intersect (p0, r0) (p1, r1)
    where
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

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

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    abs $ (dist p0 p1) - r0 - r1

intersect (p0, r0) (p1, r1) =
    abs $ (r1 + r0 - (dist p0 p1)) / 2

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d < r0 + r1   = outside (p0, r0) (p1, r1)
    | d < max r0 r1 = inside (p0, r0) (p1, r1)
    | otherwise     = intersect (p0, r0) (p1, r1)
    where
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

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


main = interact $ z.y.f.read

y ans = map (\x -> (map show x)) ans
z ans = unlines (map (\x -> unwords x) ans)

ev = [2, 4 ..]
od = [1, 3 ..]
f :: Int -> [[Int]]
f x = (g x x ev od (x `div` 2) 1 [])

g :: Int -> Int -> [Int] -> [Int] -> Int -> Int -> [[Int]] -> [[Int]]
g n 0 tempe tempo st md ans = ans
g n rw tempe tempo st md ans
  | rw > ((n `div` 2) + 1) = g n
                             (rw-1)
                             (drop (2*st) tempe)
                             (drop md tempo)
                             (st-1)
                             (md+2)
                             (((take st tempe) ++ (take md tempo) ++ (take st (drop st tempe))):ans)
  | otherwise = g n
                  (rw-1)
                  (drop (2*st) tempe)
                  (drop md tempo)
                  (st+1)
                  (md-2)
                  (((take st tempe) ++ (take md tempo) ++ (take st (drop st tempe))):ans)

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + y * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareodd size) size size

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + (y - 1) * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + (y - 1) * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareodd size) size size

import qualified Data.Char as Char

main = interact $ z.y.f.read

y ans = map (\x -> (map show x)) ans
z ans = unlines (map (\x -> unwords x) ans)

h n [] fans = fans
h n ans fans = h n (drop n ans) ((take n ans):fans)

f x = h x (g x x x 2 1 [] ) []
g n 0 cl tempe tempo ans = ans
g n rw 0 tempe tempo ans = g n (rw-1) n tempe tempo ans
g n rw cl tempe tempo ans
  | rw == ((n `div` 2) + 1) = g n rw (cl-1) tempe (tempo+2) (tempo:ans)
  | (rw == n || rw == 1) && cl == ((n `div` 2) + 1) = g n rw (cl-1) tempe (tempo+2) (tempo:ans)
  | (rw == n || rw == 1) && cl /= ((n `div` 2) + 1) = g n rw (cl-1) (2+tempe) tempo (tempe:ans)
  | (cl == n || cl == 1) = g n rw (cl-1) (tempe+2) tempo (tempe:ans)
  | otherwise = g n rw (cl-1) tempe (tempo+2) (tempo:ans)


import Data.List
import Control.Monad
main :: IO ()
main = do
    _ <- getLine
    routine

routine :: IO ()
routine = do
  xs <- (map read.words) <$> getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = (2 *) $ maximum $ zipWith min g (tail g)
  where
    g = ((map length).group) xs

module Main where
import Data.List

main = do
    getLine
    ts <- map length . group . filter (/= ' ') <$> getLine
    print $ (2*) $ maximum $ zipWith (\x y -> min x y) ts $ tail ts

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  xs <- map (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  print $ 2 * query xs

query :: [Bool] -> Int
query (x:xs) = loop 0 x 1 0 xs
  where
    loop !maxi !prev !prevlen !prevprevlen (x:xs)
      | x == prev = loop maxi x (prevlen +1) prevprevlen xs
      | otherwise = loop (max maxi (min prevlen prevprevlen)) x 1 prevlen xs
    loop !maxi !prev !prevlen !prevprevlen []
      = max maxi $ min prevlen prevprevlen

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

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

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

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

import Control.Monad
import Data.List
import Data.Maybe
-- import Data.List.HT (mapAdjacent)
import qualified Data.ByteString.Char8 as B

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

mapAdjacent f = map (uncurry f) . (zip <*> tail)

solve :: [Int] -> Int
solve = (*2)
      . maximum
      . mapAdjacent min
      . map length
      . group

main :: IO ()
main = do
    _ <- getLine
    v <- readInts
    print $ solve v

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

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

---- Answer Code Section ----

process :: [Int] -> Int
process sushis = maximum combinations where
    combinations = combine . map length . group $ sushis
    combine (x:y:xs) = 2 * min x y : combine (y:xs)
    combine _        = []

main = do
    n <- getInt
    sushis <- getInts
    print $ process sushis

import Data.List
main = interact $ show . (*2) . process . map read . tail . words
process :: [Int] -> Int
process ns = maximum $ zipWith min ll $ tail ll
  where ll = map length $ group ns