solve [a,b,c] = s a b c 1
  where
   s a b c x | even a && even b =  s (a `div` 2) (b`div`2) c (x*2*2)
             | even a && odd b  =  s (a `div` 2) b c (x*2)
             | odd a  && even b =  s a (b`div`2) c (x*2)
             | odd a  && odd b  =  if x >= c then "YES" else "NO"

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

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

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

kp2 :: Integer -> Integer
kp2 n
  | n `mod` 2 == 0 = 2 * kp2 (n `div` 2)
  | otherwise = 1

solve :: [Integer] -> String
solve [w, h, n]
  | kp2 w * kp2 h >= n = "YES"
  | otherwise = "NO"

solveCase :: IO String
solveCase = fmap solve readInts

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

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

ans [w,h,n]
    | solve (w * h) >= n = "YES"
    | otherwise = "No"

solve = product . (2 <$) . takeWhile even . iterate (`div` 2)

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

solve [w,h,n]
    | 2 ^ (f w + f h) >= n = "YES"
    | otherwise = "NO"

f x
    | even x = 1 + f (div x 2)
    | otherwise = 0

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import safe Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import Data.List
import Data.Function
import Data.Maybe

main :: IO ()
main = TI.getContents >>= (T.lines >>> drop 1 >>> tcio >>> (mapM_ putStrLn)) where
  tcio :: [T.Text] -> [String]
  tcio [] = []
  tcio (nm : rest) = ((:[]). solve . linetois) nm ++ tcio (drop 0 rest)
  linetoi = toi; linetois = (map linetoi).(T.words); linestoiss = map linetois
  --itoline = show; istoline = unwords . (map itoline); isstolines = map istoline
  toi t = toi0 0 t where toi0 n t = if (T.null) t then n else toi0 (10*n + fromIntegral(on (-) fromEnum (T.head t) '0') ) (T.tail t) ;

solve :: [Int] -> String
solve [w,h,n] = if mx2pow w * mx2pow h >=n then "YES" else "NO" where
  mx2pow x = last $ takeWhile (\p->x `mod` p == 0) [2^k | k<-[0..]]

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM) -- foldM est un foldl
import Data.Maybe

numOcc :: Ord a => [a] -> M.Map a Integer
numOcc (x:xs) = let m = numOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
numOcc [] = M.empty

numOcc' :: A.Ix a => (a, a) -> [a] -> A.Array a Integer
numOcc' size list = runSTArray $ do
	array <- MA.newArray size 0
	foldM (addElem array) () list
	return array

	where
		addElem :: A.Ix a=> STArray s a Integer -> () -> a -> ST s ()
		addElem array action a = do
			i <- MA.readArray array a
			MA.writeArray array a (i+1)

insertWithList :: Ord a => a -> b -> M.Map a [b] -> M.Map a [b]
insertWithList a b m = case M.lookup a m of
	Just l -> M.insert a (b:l) m
	Nothing -> M.insert a [b] m

deleteWithList :: Ord a => a -> M.Map a [b] -> M.Map a [b]
deleteWithList a m = case M.lookup a m of
	Just (x:y:xs) -> M.insert a (y:xs) m
	Just [x] -> M.delete a m

solve :: Integer -> Integer -> Integer -> Bool

solve w h n = (1 + aux w) * (1 + aux h) >= n where
	aux k
		| mod k 2 == 0 = 1 + 2 * aux (div k 2)
		| otherwise = 0

plotResult True = putStrLn "Yes"
plotResult False = putStrLn "No"

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[w, h, n] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		plotResult $ solve w h n

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array
import Data.Char
import Data.List
import Data.Int
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Control.Applicative
import System.IO
import Data.Bits

-- import qualified Data.Set as Set

readInt :: String -> Int
readInt = read

printArr :: (Show a) => String -> [a] -> IO ()
printArr sep arr = do
    putStrLn . intercalate sep $ (show <$> arr)

print2DArr :: (Show a) => String -> [[a]] -> IO ()
print2DArr sep arr = sequence_ (printArr sep <$> arr)

every n xs = case drop (n-1) xs of
            (y:ys) -> y : every n ys
            [] -> []

yon True = "YES"
yon False = "NO"

main = do
    -- input <- openFile "in" ReadMode
    let input = stdin
    hSetBuffering input (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- hGetContents input
    -- printArr (readIntArr $ head q) " "
    solve contents

solve inp = sequence do
    [x, y, n] <- (readInt <$>) . words <$> tail (lines inp)
    let x' = 1 `shift` countTrailingZeros x
        y' = 1 `shift` countTrailingZeros y
    [putStrLn $ yon (x'*y' >= n)]

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

--------------------------------------------------------------------------------

process :: IO ()
process = do
    [w, h, n] <- getIntList
    putStrLn $ yesOrNo $ (n <= (f w * f h))

f :: Int -> Int
f x | odd x = 1
    | otherwise = 2 * f (x `div` 2)

count :: Int -> Int
count x | x `mod` 2 == 0 = 1 +  count ( x `div` 2)
        | otherwise = 0

fn :: [Int] -> String
fn x | (2^(count (x!!0)))*(2^(count (x!!1))) >= (x!!2) = "Yes"
     | otherwise = "No"

func::[Int] -> [[Int]]
func [] = []
func x = [take 3 x] ++ func (drop 3 x)
out::[[Int]] -> [String]
out x = [fn y | y <- x]
parsei::String -> [Int]
parsei x = [read k :: Int | k <- tail(words x)]

parseo::[String] -> String
parseo x = concat ([k ++ "\n" | k <- x])
totalfun::String -> String
totalfun x = parseo(out(func(parsei(x))))

main = interact $ totalfun

import Control.Arrow
main = interact $ lines >>> drop 1 >>> map (words >>> map read >>> solve) >>> unlines

solve :: [Int] -> String
solve [w, h, n]
  | ((two (w*h)) >= n) = "YES"
  | otherwise = "NO"

two :: Int -> Int
two x
  | (mod x 2 == 0) = 2 * two (div x 2)
  | otherwise = 1

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

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             join, replicateM_)
import qualified Control.Monad.State.Strict as S
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, 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)
-- debug = flip trace

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

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

solve :: Int -> Int -> Int -> Bool
solve w h n = cntTwo w h >= n
    where
        cntTwo w h
            | even w    = 2 * cntTwo (w `div` 2) h
            | even h    = 2 * cntTwo w (h `div` 2)
            | otherwise = 1

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [w, h, n] <- B8.getLine <&> map readIntB8 . B8.words
        let answer = solve w h n
        printf "%s\n" ((if answer then "YES" else "NO")::String)

{-# LANGUAGE
    BangPatterns
  , BlockArguments
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , DerivingVia
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , NPlusKPatterns
  , NegativeLiterals
  , OverloadedLabels
  , OverloadedStrings
  , ParallelListComp
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , StrictData
  , TupleSections
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , ViewPatterns
  #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
import           System.IO
import           Data.Proxy
import           GHC.TypeLits
import           GHC.Generics                   ( Generic )
import           Data.Function
-- import           Data.List.HT                   ( mapAdjacent
--                                                 , isAscending
--                                                 )
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
import qualified Data.Set                      as S
-- import qualified Data.Vector.Algorithms.Radix  as VA
-- import           Text.Parsec.ByteString

-- #if defined(LOCAL_ZER0STAR)
-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}
-- #endif

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

both2 f (a1, b1) (a2, b2) = (f a1 a2, f b1 b2)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

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

main = do
  t <- getInt
  replicateM_
    t
    do
      [w, h, n] <- getIntegers
      let
        f = toInteger . length . takeWhile ((== 0) . (`mod` 2)) . iterate
          (`div` 2)
        ww = f w
        hh = f h
      putStrLn if 2 ^ (ww + hh) >= n then "Yes" else "No"

import Control.Monad

cont :: Int -> Int
cont = go 1  where
  go x y
    | odd y      = x
    | otherwise  = go (2*x) (div y 2)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [w, h, n] <- map read . words <$> getLine :: IO [Int]
    putStrLn $ if  cont w * cont h >= n
      then  "YES"
      else  "NO"

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

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

kp2 :: Integer -> Integer
kp2 n
  | n `mod` 2 == 0 = 1 + kp2 (n `div` 2)
  | otherwise = 1

solve :: [Integer] -> String
solve [w, h, n]
  | kp2 w * kp2 h >= n = "YES"
  | otherwise = "NO"

solveCase :: IO String
solveCase = fmap solve readInts

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)


module Main where

import Data.List (sort, maximum)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

chunks0 _ [] = []
chunks0 n as = (take n as) : chunks0 n (drop n as)

chunks n = filter ((== n) . length) . chunks0 n

getTeamCount k n participants
  | n < 3 = 0
  | otherwise =
      length
        $ filter (<= 5)
        $ map ((+ k) . maximum)
        $ chunks 3 participants

main :: IO ()
main = do
  (n:k:_) <- readNumbers
  participants <- take n `fmap` readNumbers
  print (getTeamCount k n (sort participants))

solve :: String -> String
solve s = show $ quot cnt 3
  where (x:y:xs) = map read (words s)
        cnt = length (filter (\x -> 5 - y >= x) xs)

main = do
  interact solve

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

main :: IO ()
main = do
	[_,k] <- inputInts
	xs <- inputInts
	print . (`div` 3) . length . filter (<= 5 - k) $ xs

{-# LANGUAGE TupleSections #-}

-- For Input
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
--import qualified Data.ByteString.Lex.Double as BSD
import Data.Char (isSpace)
import Data.IORef
import Text.Printf

-- Data Structure Imports
import Data.Maybe
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

-- These should be imported by default... :)
import Control.Monad
import Control.Applicative
import Control.Arrow

--------------------------------------------------------------------------------
------------------------------- SOLUTION ---------------------------------------
--------------------------------------------------------------------------------

main :: IO ()
main = do
  all   <- BS.getContents
  input <- newIORef all
  let parse = next input
  (n,k) <- parse int2
  ys <- parse $ intMany n
  let solution = length (filter (\y -> y + k <= 5) ys) `div` 3
  putStrLn $ show solution

--------------------------------------------------------------------------------
-------------------------- IO Function Helpers ---------------------------------
--------------------------------------------------------------------------------

type Parser a = BSC.ByteString -> (a, BSC.ByteString)

int :: Parser Int
int = second (BSC.dropWhile isSpace) . fromJust . BSC.readInt

int2 :: Parser (Int, Int)
int2 = uncurry (first . (,)) . second int . int

int3 :: Parser (Int, Int, Int)
int3 = uncurry (first . (uncurry (,,))) . second int . int2

--double :: Parser Double
--double = second (BSC.dropWhile isSpace) . fromJust . BSD.readDouble

char :: Parser Char
char = BSC.head &&& BSC.tail

letter :: Parser Char
letter = second (BSC.dropWhile isSpace) . char

string :: Parser String
string = (BSC.unpack *** BSC.dropWhile isSpace) . BSC.span (not . isSpace)

readMany :: Parser a -> Int -> Parser [a]
readMany f n bs = first reverse $
                  foldr (\_ (l,bs) -> first (:l) $ f bs) ([],bs) [1..n]

intMany :: Int -> Parser [Int]
intMany = readMany int

next :: IORef BSC.ByteString -> Parser a -> IO a
next input parse = do
  bs <- readIORef input
  let (x, bs') = parse bs
  writeIORef input bs'
  return x

{- CODE JAM input

  cases <- parse int
  forM_ [1..cases] $ \caseNum -> do
         -- Read Data
         -- let solution =
         -- solution <-
         printf "Case #%d: %d\n" caseNum solution
-}

import Control.Applicative
import Data.List

main= do
	[_,k]<-  map read. words <$> getLine ::IO [Int]
	s<- sort.map read.words <$> getLine::IO [Int]
        print $ div (length (takeWhile (<=5-k) s)) 3

import Data.List
main = do
  [n, k] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. filter (< (6 - k)). map read. words :: IO [Int]
  print. (`div` 3). length $ a

import Control.Applicative

main = do
    [n, k] <- map read . words <$> getLine
    ys <- map read . words <$> getLine
    print $ (length $ filter (<= (5-k)) ys) `div` 3

process :: Int -> [Int] -> Int
process k xs = length (filter (\x -> x+k<=5) xs) `div` 3

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,k] <- fmap (map readInt.words) getLine
    ys <- fmap (map readInt.words) getLine
    print $ process k ys

main = do
    [n,k] <- fmap (map read . words) getLine :: IO [Int]
    y <- fmap (map read . words) getLine :: IO [Int]
    print $ (length $ filter (<= 5 - k) y) `div` 3

main = do
    let i=fmap (map read.words) getLine::IO [Int]
    [n,k]<-i
    y<-i
    print $ (length $ filter (<6-k) y) `div` 3

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

solve :: [Int] -> Int
solve (_:k:xs) = flip div 3 $ length $ filter (5-k >= ) xs

import Control.Applicative

main :: IO ()
main=interact solve

solve :: String -> String
solve s = show $ answer k xs
    where (_:k:xs) = read<$>words s

answer :: Int -> [Int] -> Int
answer k xs = quot (sum [1 | i <- xs, k + i <= 5]) 3

import Control.Monad

readListLn :: IO [Int]
readListLn = (map (read :: String -> Int) . words) `liftM` getLine

main :: IO ()
main = do
    [_, k] <- readListLn
    y <- readListLn
    putStr $ show $ length (filter (<=5-k) y) `div` 3

import Data.List
import Data.Function
import Data.Char

main = interact $ show . getAns . map read . words

getAns :: [Int] -> Int
getAns (n:k:xs) = let ns = (length . filter (<=5) . map (+k)) xs
				in ns `div` 3

main = do
  [_, k] <- fmap (map read . words) getLine
  ys <- fmap (map read . words) getLine

  let c = length $ filter (\x -> x + k <= 5) ys
  print $ c `div` 3

main = do
  (n:k:_) <- fmap (map read . words) getLine :: IO [Int]
  nums <- fmap (map read . words) getLine
  let answer = length (filter (\a -> k+a <= 5) nums) `div` 3
  print answer

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<$>))
import Text.Printf
import Data.Maybe (Maybe, fromMaybe)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  [n, k] <- readInts
  y <- readInts
  print . (`div` 3) . length . filter (<= 5 - k) $ y

toNumber = fst . fromMaybe (0, "")
readInt = toNumber . BS.readInt <$> BS.getLine
readInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  solve.tail.concat =<< (forM [1..2] $ \i-> map (fst.fromJust.C.readInt).C.words <$> C.getLine)

solve (x:xs) = let l = length $ filter (\a->a+x<=5) xs in print $ l `div` 3

import Control.Applicative
import Data.List (sort)

main = do
  [_, k] <- map read . words <$> getLine
  ss <- sort . map read . words <$> getLine
  let
    f xs
      | length xs < 3 = 0
      | all (<=5) . map (+k) $ take 3 xs = 1 + f (drop 3 xs)
      | otherwise = 0
    in putStrLn . show $ f ss

import Data.List

conv = map (read::String->Int) . words
g k xs = div ((length . sort) [x | x <- xs , 5 - x >= k]) 3

main = do
    i <- getLine
    x <- getLine
    let k = (conv i) !! 1
    let xs = conv x
    putStrLn $ show (g k xs)

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ filter (<=5-k) q) 3

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

solve :: [Int] -> Int
solve (_:k:ys) = length (filter (<=5-k) ys) `div` 3
solve _ = undefined

main = interact $ show . solve . map read . words
solve (n:k:ns) = (`div` 3) $ length $ filter (<= 5 - k) ns

import Data.List

strToList = (fmap (read :: (String -> Int))).words

f xs k = (length $ filter (<=5) $ map (+k) xs) `div` 3

main = do

    [n, k] <- fmap strToList getLine

    s <- fmap strToList getLine

    putStrLn $ show $ f s k

import Text.Printf (printf)
import Control.Monad (forM_)

main :: IO ()
main = do
  [n, k] <- fmap (map read . words) getLine :: IO [Int]
  xs <- fmap (map read . words) getLine :: IO [Int]
  print $ length (filter (\x -> x + k <= 5) xs) `div` 3

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ takeWhile (>=5-k) q) 3

import Control.Applicative
import Data.List

main=do
     [n,k]<-    map read <$> words <$> getLine::IO [Int]
     q<-map read <$> words <$> getLine::IO [Int]
     print $ div ( length $ takeWhile (<=5-k) q) 3

import Data.List
main = do
  [n, k] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. filter (< (4 - k)). map read. words :: IO [Int]
  print. (`div` 3). length $ a


import Control.Monad

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 return result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- replicateM t (do ans)
 putStrLn (unwords results)

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 return result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (unwords results)

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum (map (\x -> read x :: Int) b) `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = replicate t ans
 sequence results

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = replicate t ans
 sequence results

ans = do
 nInput <- getLine
 aInput <- getLine
 mInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = words aInput
 let m = read mInput :: Int
 let b = words bInput
 let pos = 1 + sum [read x :: Int | x <- b] `mod` n
 let result = if pos == 0 then a !! (n - 1) else a !! (pos - 1)
 putStrLn result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 let results = [ans | x <- [1 .. t]]
 sequence results

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

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Data.Word (Word32)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, m :: Int, a :: [Int], b :: [Int]}

aliceBob x = if x then "Alice" else "Bob"

solve TC {..} = a!!p
  where
    p = (sum b) `mod` n

main = C.interact $ runScanner scan >>> map solve >>> map show >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        m <- int
        b <- m >< int
        pure $ TC n m a b
    )

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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


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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np $ 1 : [x+2, 2*x+2 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, x, y] -> case matchOf n x y of
                        Nothing -> putStrLn "-1"
                        Just as -> mapM_ (\a -> putStr (show a ++ " ")) as >>
                                   putStrLn ""

matchOf :: Int -> Int -> Int -> Maybe [Int]
matchOf n x y | (x /= 0 && y /= 0) || (x == 0 && y == 0) = Nothing
              | otherwise = let k = if x == 0 then y else x in
                              if (mod (n-1) k) == 0
                              then Just $ concatMap (replicate k) [2+k*i | i <- [0..(div (n-1) k)-1]]
                              else Nothing

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ y) 2
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ (y + 1)) 1
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np [1, 1+x+1 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing


g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = 0
f n as bs
  | (null bs) || (not (null as)) && ((head as) < (head bs)) = 1 + f (n - 1) (tail as) bs
  | otherwise = f(n - 1) as (tail bs)
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let k = f n as bs
  putStrLn $ [if x <= (max k (div n 2)) then '1' else '0' | x <- [1..n]]
  putStrLn $ [if x <= (max (n - k) (div n 2)) then '1' else '0' | x <- [1..n]]

g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = (0, 0)
f n [] (b:bs) = (p, q + 1) where (p, q) = f (n - 1) [] bs
f n (a:as) [] = (p + 1, q) where (p, q) = f (n - 1) as []
f n (a:as) (b:bs)
  | a < b = let (p, q) = f (n - 1) as (b:bs) in (p + 1, q)
  | otherwise = (r, s + 1) where (r, s) = f(n - 1) (a:as) bs
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let (an, bn) = f n as bs
  let (man, mbn) = (max an (div n 2), max bn (div n 2))
  putStrLn $ (replicate man '1') ++ (replicate (n - man) '0')
  putStrLn $ (replicate mbn '1') ++ (replicate (n - mbn) '0')


{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns,
  FlexibleContexts,
  TypeApplications,
  MultiWayIf #-}

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

main = do
  [!t] <- readInts
  replicateM_ t solve

solve = do
  [!n, !c, !q] <- readInts
  s <- listArray @UArray (0,n-1) <$> getLine
  cs <- replicateM c $ do
    [!l, !r] <- readInts
    return (l,r)
  qs <- replicateM q (head <$> readInts)
  let go _ [] = []
      go !ind ((l,r):xs) = (ind,l-1,r-1) : go (ind+r-l+1) xs
      cs' = reverse $ go n cs
      find [] i = i
      find ((ind,l,r):xs) i
        | i >= ind = find xs (i - ind + l)
        | otherwise = find xs i
  mapM_ (putStrLn . (:[]) . (s!) . find cs' . subtract  1) qs

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

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,c,q] <- ri
        s        <- B.takeWhile isPrint <$> B.getLine
        [lrs,qs] <- mapM (`replicateM` ri) [c,q]
        return (s,lrs,qs)
    mapM_ (putStr.showChars.solve) tcs

showChars = unlines . map (:"")

solve (s,lrs,qs) = ans
  where
    (_,offMap) = foldl nxt (B.length s, Map.empty) . map lr2il $ lrs
      where
        lr2il = f  where  f [l,r] = (l, r+1-l)
                          f _     = error "Input error (LR pair)"

        nxt (len, imap) (si,slen) = (len+slen, (len+1) `Map.insert` (len+1-si) $ imap)

    ans = map (B.index s . pred . v2i) qs
      where
        v2i [i] = case (Map.lookupLE i offMap) of
            Nothing      -> i
            Just (_,off) -> v2i [i - off]

        v2i _ = error "Input error (single index expected)"


doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y  = doprob (x:xs) ys
  | x == y = doprob xs ys
  | x < y  = doprob xs ys

tolist :: String -> [Int]
tolist = map read . words

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)

main = do
   nm <- getLine
   an <- getLine
   bn <- getLine
   let xs = map read (words an) :: [Int]
       ys = map read (words bn) :: [Int]
       ans = solve xs ys
   print ans

solve [] _ = 0
solve xs [] = length xs
solve (x:xs) (y:ys)
   | x <= y    = solve xs ys
   | otherwise = solve (x:xs) ys

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs (y:ys) (acc+1)
    |otherwise  = solve xs ys acc

import Control.Monad

deal [] _ = []
deal as [] = as
deal (a:as) (b:bs)
  | a <= b = deal as bs
  | True = deal (a:as) bs

main = do
  [n, m] <- liftM (map read . words) getLine :: IO [Int]
  as <- liftM (map read . words) getLine :: IO [Int]
  bs <- liftM (map read . words) getLine :: IO [Int]
  putStrLn . show . length $ deal as bs

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe
-- import Debug.Trace

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

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = if a <= b then f as bs else f (a:as) bs

  print $ f as bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | otherwise = 1 + f as bs

solve :: [Int] -> [Int] -> Int
solve [] wants = length wants
solve _ []     = 0
solve (h:ht) ws@(w:wt)
  | h >= w    = solve ht wt
  | otherwise = solve ht ws

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  wants <- getLine --> words --> take n --> map read
  haves <- getLine --> words --> take m --> map read
  print $ solve haves wants

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs ys (acc+1)
    |otherwise  = solve xs ys acc

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as _ = length as
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f [] _ = 0
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  print $ length $ as \\ bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | b > a = f as (b:bs)
  | b == a = 1 + f as bs

doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y = 1 + doprob xs ys
  | x <= y = doprob xs ys

tolist :: String -> [Int]
tolist = map read . words

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)


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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack, reverse, dropWhile)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)
import Data.Char (isSpace)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

rstrip = C.reverse . C.dropWhile isSpace . C.reverse

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack . rstrip -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

decreaseElem Nothing = Nothing
decreaseElem (Just x) = if x > 1 then (Just (x - 1)) else Nothing

solve [] [] u _ = u
solve [] (t:ts) u f = solve [] ts (t:u) f
solve (s:ss) [] u f = solve ss [s] u (Map.alter decreaseElem s f)
solve (s:ss) (t:ts) u f
 | t <= (fst $ Map.findMin f) = solve (s:ss) ts (t:u) f
 | otherwise = solve ss (s:t:ts) u (Map.alter decreaseElem s f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  putStrLn $ map chr $ reverse $ solve v [] [] (getFreq v Map.empty)

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | s == c
    = if nc > 1
        then solve ss t (s:u) c (nc - 1) f
        else solve ss t (s:u) (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (f Map.! a) f

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | nc == 0 = solve (s:ss) t u (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | s == c = solve ss t (s:u) c (nc - 1) f
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (Map.findWithDefault 0 a f) f

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStr $ run [] (cmap (L.sort xs) M.empty) xs


import Control.Monad

solve :: [Int] -> Int
solve l = max 0 (2*(ma-mi-2))
  where
    ma= maximum l
    mi= minimum l

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

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

import Control.Monad (replicateM_)
import Data.List (sort)

findMin :: [Int] -> Int
findMin xs = max 0 (2*(mx - mn - 2)) where
    [mn, mid, mx] = sort xs

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

main =
    read <$> getLine >>= \q ->
    replicateM_ q (findMin <$> readLine >>= print)

module Main where

import Control.Monad
import Data.List

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    cas <- readLn
    replicateM_ cas $ do
        [a, b, c] <- sort <$> getList
        print $ cal a b c

cal :: Int -> Int -> Int -> Int
cal a b c
    | a == b && b == c = 0
    | otherwise = max 0 ((c - a) * 2 - 4)


import Control.Applicative
import Data.List
import Data.Char

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  s <- getLine

  let count = [length $ filter (==c) s | c <- map (chr . (+(ord 'A'))) [0..k-1]]

  print $ minimum count * k

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

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

get = map read . words <$> getLine

sol [n,k] s = (* k) . last . take k . sortBy (flip compare) . elems . accumArray (+) 0 ('A','Z') . zip s $ repeat 1

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

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

longestGoodSubsequence :: Int -> String -> Int
longestGoodSubsequence k s
    | c /= k    = 0
    | otherwise = c * b
        where a = map length $ group $ sort s
              b = minimum a
              c = length a

main :: IO ()
main = do
    [n, k] <- readInts
    s      <- getLine
    print $ longestGoodSubsequence k s

import Data.List
main = interact $ show . solve . tail . words
solve [k,s] | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s

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

main = do
		[n,k]<-map read <$> words <$> getLine ::IO [Int]
		s<-getLine
		let m=  map length $ group $ sort s
		print $ if length m <k then 0 else k*minimum m

{-# LANGUAGE ViewPatterns #-}
module Main where
import Data.Array.Unboxed

main = interact exec
exec = show . (\[_, read -> k, xs] -> solve k xs) . words
solve k xs = (k *) $ minimum $ take k $ elems (accumArray (+) 0 ('A', 'Z') $ zip xs (repeat 1) :: UArray Char Int)

import Data.List (sort, group)

process :: Int -> [Char] -> Int
process k xs = k * minimum (take k $ ls ++ (repeat 0))
    where ls = map length $ group $ sort xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n, k] <- fmap (map readInt.words) getLine
    xs <- getLine
    print $ process k xs

import Data.List

main = do
       e<-getLine
       e2<-getLine
       let (n:k:[])=map read (words e)::[Int]
           xs=map length $ group $ sort e2
       print $ if k==(length xs) then k*(minimum xs) else 0

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS

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

count :: B8.ByteString -> MapS.Map Char Int
count string = B8.foldr' (flip update) MapS.empty string
    where update map char = MapS.alter (\value -> Just $ 1 + fromMaybe 0 value) char map

main :: IO ()
main = do
    [n, k] <- (map readB8Int) <$> B8.words <$> B8.getLine
    string <- B8.getLine
    let keys = take k ['A'..'Z']
    let counts = count string
    let charCount = foldr1 min . map (\x -> fromMaybe 0 $ MapS.lookup x counts) $ keys
    printf "%d\n" (charCount * k)

import Data.List
main = interact $ show . solve . tail . words
solve (k:s) | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s


import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        map read .words <$> getLine >>= putStrLn . show . solve n k (a+1)

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, (n + 1) `div` (a + 1) - k, fromList [0, n + 1])
    count x y = (y - x) `div` (a + 1)

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf + count u i + count i v - count u v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs

import Data.IntSet (insert, fromList, lookupGT, lookupLE)

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

solve :: [Int]->Int
solve (n:k:a:_:x)  = let tot = (n+1) `div` (a+1)
                         check _ _ _ [] = -1
                         check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`(a+1) + (r-x)`div`(a+1) - (r-l)`div`(a+1)
                     in check (fromList [0, n+1]) 1 tot x

import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        x <-  map read . words <$> getLine
        putStrLn $ show $ solve n k (a+1)  x

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, n `div` a - k, fromList [0, n + 1])
    count x y = (y - x - 1) `div` a

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf - count u v + count u i + count i v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs


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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , j <- [0..7]
        -- , x || (mask .&. i) == mask
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j)
          | isOne || (mask .&. i) == mask = do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          let gg = (go c1 c2 x)
          mapM_  gg indices
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          mapM_ (go c1 c2 x) indices
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          mapM_ (go c1 c2 x) indices
          resetArray c1
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    c2 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 c2 xs
    where
      gogo :: Count -> Count -> [Bool] -> IO Count
      gogo c1 c2 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          mapM_ (go c1 c2 x)  indices
          resetArray c1
          gogo c2 c1 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , j <- [0..7]
        , x || (mask .&. i) == mask
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        |
        (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            -- print (k, i, j)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        |
        (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            print (k, i, j)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | mask <-[0..7]
        , i <- [0..7]
        , (k, x) <- zip [0..length xs-1] xs
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | mask <-[0..7]
        , i <- [0..7]
        , (k, x) <- zip [0..length xs-1] xs
        , x || mask .&. i == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = Map.IntMap Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> Count
solve1 xs = foldl
  (\m (k, a) ->  foldr (\(mask, g) m1 ->  go m m1 a k mask (g`div`8) (g`mod`8)) Map.empty $ liftM2 (,) [0..7] (Map.keys m))
  (Map.fromList [((0 `gi` 0),1)])
  (zip [0..] xs)
    where
      updateX :: Int -> Maybe Int -> Maybe Int
      updateX x Nothing = Just x
      updateX x (Just y) = Just (x+y)
      inject :: Count -> (Int, Int) -> Count
      inject c (k, v) = Map.alter (updateX v) k c

      go ::
        Count
        -> Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> Count
      go c c2 isOne k mask i j
        | isOne || (mask .&. i) == mask = inject c2 ((ni`gi`nj), c Map.! (i `gi` j))
        | otherwise = inject c2 ((0`gi`0),0)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve :: Solver
solve xs = (`mod` mm) $ sum $ Map.elems $ Map.filterWithKey (\k _ -> k`mod`8==7) $ solve1 xs

main :: IO ()
main = do
  printAns =<< solve <$> parse
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = Map.IntMap Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> Count
solve1 xs = foldl
  (\m ys -> Map.fromListWith (((`mod` mm).) . (+)) $ (\(isOne, k, mask,i,j) -> go m isOne k mask i j) <$> ys (Map.keys m))
  (Map.fromList [((0 `gi` 0),1)])
  indices
    where
      indices =
        [\keys -> [(xs!!k, k, mask, g `div` 8, g `mod` 8) | mask <-[0..7],g <- keys ] | k <- [0..length xs-1]]
      go :: Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> (Int, Int)
      go c isOne k mask i j
        | isOne || (mask .&. i) == mask = ((ni`gi`nj), c Map.! (i `gi` j))
        | otherwise = ((0`gi`0),0)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve :: Solver
solve xs = (`mod` mm) $ sum $ Map.elems $ Map.filterWithKey (\k _ -> k`mod`10==7) $ solve1 xs

main :: IO ()
main = do
  printAns =<< solve <$> parse
  return ()

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

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

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

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

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

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

type Count = IOUArray Int Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 10 + j

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray (0, 7`gi`7) 0
    writeArray c1 0 1
    foldlM goBig c1 indices
    where
      goBig :: Count -> [(Bool, Int, Int, Int, Int)] -> IO Count
      goBig c1 xs = do
        c2 <- newArray (0, 7`gi`7) 0
        mapM_ (\(isOne, k, mask,i,j) -> go c1 c2 isOne k mask i j) xs
        return c2

      indices = [[(xs!!k, k, mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]] | k <- [0..length xs-1]]
      go ::
        Count
        -> Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> IO ()
      go c1 c2 isOne k mask i j
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i `gi` j)
            val2 <- readArray c2 (ni`gi`nj)
            writeArray c2 (ni`gi`nj) (val1+val2)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve2 :: IOUArray Int Int -> Int
solve2 xs = undefined
go :: [Bool] -> IO ()
go bs = do
  na <- newArray (0, length bs -1 ) 0
  let x = solve2 na
  return ()

a :: Int
a = 1 .&. 1

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (\x -> mod (sum x) mm) <$> sequence (readArray res <$> [i `gi` 7 |i <- [0..7]])
  -- printAns =<<
  return ()


toArray :: String -> [Int]
toArray = map (read :: String -> Int) . words

process :: [Int] -> Int
process = maximum . compress
    where  compress [] = []
           compress (x : xs) =
               let (pref, suf) = span (==x) xs
               in 1 + length pref : compress suf

main :: IO ()
main = interact (unlines . map (show . process . toArray) . takeEven . tail . lines)
    where takeEven l = map snd $ filter (even . fst) (zip [1..] l)

toArray :: String -> [Int]
toArray = map (read :: String -> Int) . words

process :: [Int] -> Int
process = maximum . compressed
    where compressed [] = []
          compressed (x : xs) = 1 + length (takeWhile (==x) xs) :
                                    compressed (dropWhile (==x) xs)

main :: IO ()
main = interact (unlines . map (show . process . toArray) . takeEven . tail . lines)
    where takeEven l = map snd $ filter (even . fst) (zip [1..] l)