Vasya's bicycle chain drive consists of two parts: n stars are attached to the pedal axle, m stars are attached to the rear wheel axle. The chain helps to rotate the rear wheel by transmitting the pedal rotation.We know that the i-th star on the pedal axle has ai (0 < a1 < a2 < ... < an) teeth, and the j-th star on the rear wheel axle has bj (0 < b1 < b2 < ... < bm) teeth. Any pair (i, j) (1 ≤ i ≤ n; 1 ≤ j ≤ m) is called a gear and sets the indexes of stars to which the chain is currently attached. Gear (i, j) has a gear ratio, equal to the value .Since Vasya likes integers, he wants to find such gears (i, j), that their ratios are integers. On the other hand, Vasya likes fast driving, so among all "integer" gears (i, j) he wants to choose a gear with the maximum ratio. Help him to find the number of such gears.In the problem, fraction  denotes division in real numbers, that is, no rounding is performed.

The first input line contains integer n (1 ≤ n ≤ 50) — the number of stars on the bicycle's pedal axle. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 104) in the order of strict increasing. The third input line contains integer m (1 ≤ m ≤ 50) — the number of stars on the rear wheel axle. The fourth line contains m integers b1, b2, ..., bm (1 ≤ bi ≤ 104) in the order of strict increasing. It is guaranteed that there exists at least one gear (i, j), that its gear ratio is an integer. The numbers on the lines are separated by spaces.

Print the number of "integer" gears with the maximum ratio among all "integer" gears.

NoteIn the first sample the maximum "integer" gear ratio equals 3. There are two gears that have such gear ratio. For one of them a1 = 4, b1 = 12, and for the other a2 = 5, b3 = 15.

main = do
  getLine
  a <- fmap (map read . words) getLine
  getLine
  b <- fmap (map read . words) getLine
  print $ gao a b
  where
    gao a b = length $ filter (==maximum c) c
      where
        c = [div j i | i <- a, j <- b, mod j i == 0]

combination::[Int]->[Int]->[(Int,Int)]
combination [] _ = []
combination (x:xs) ys = [(x,yy) | yy <- ys] ++ combination xs ys

getMax::[(Int,Int)] -> Int
getMax [] = 0
getMax (x:xs)
       | (((snd x) `mod` (fst x)) == 0) = max ((snd x) `div` (fst x)) (getMax xs)
       | otherwise = max 0 (getMax xs)

count::[(Int,Int)] -> Int -> Int
count xs maxi = sum [1|x <- xs, ((snd x) `mod` (fst x)) == 0, ((snd x) `div` (fst x)) == maxi]

main = do
     _ <- getLine
     arg1 <- getLine
     let xs = map (read::String->Int) $ words arg1
     _ <- getLine
     arg2 <- getLine
     let ys = map (read::String->Int) $ words arg2
     let comb = combination xs ys
     let maxi = getMax comb
     putStrLn(show $ count comb maxi)

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

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

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

main = do
  getLine
  as <- getInts
  getLine
  bs <- getInts

  let
    m = maximum [b`div`a | b <- bs, a <- as, b`mod`a == 0]
    c = length $ [(a, b) | b <- bs, a <- as, b`mod`a == 0, b`div`a == m]

  print c

#! /usr/bin/runhaskell
import Data.List
main = do
  n <- readLn :: IO Int
  str <- getLine
  let a = map read (words str) :: [Int]
  m <- readLn :: IO Int
  str <- getLine
  let b = map read (words str) :: [Int]
  let list = f b a
  let m = maximum list
      c = length $ filter (==m) list
      in print c

f b a =
  if b == []
     then []
  else list ++ f (tail b) a
    where hb = head b
          list = map (\x -> hb `div` x) $ filter (\x -> hb `mod` x == 0) a

import Control.Applicative
import Data.List
-- Reduction ratio
rratio :: Int -> Int -> Maybe Int
rratio ifwd jbck =
    case m of 0 -> Just d
              _ -> Nothing
    where (d, m) = jbck `divMod` ifwd

maxby :: Maybe Int -> Maybe Int -> Ordering
maxby Nothing Nothing   = EQ
maxby Nothing _         = LT
maxby _ Nothing         = GT
maxby (Just x) (Just y) = compare x y

countmax :: [Int] -> [Int] -> Int
countmax ai bj =
    case mr of Nothing -> 0
               _ -> length $ filter (\x -> x == mr) rx
    where rx = rratio <$> ai <*> bj
          mr = maximumBy maxby rx

getInt x = read x :: Int

main = do
    n <- getLine
    ai <- fmap (map getInt . words) getLine
    m <- getLine
    bj <- fmap (map getInt . words) getLine
    print $ countmax ai bj

{-
Цепная передача Васиного велосипеда состоит из двух частей: n звездочек закреплены на оси педалей, а m звездочек — на оси заднего колеса. С помощью цепи вращение педалей передается на заднее колесо.

Известно, что i-ая звездочка на оси педалей имеет ai (0 < a1 < a2 < ... < an) зубьев, а j-ая звездочка на оси заднего колеса имеет bj (0 < b1 < b2 < ... < bm) зубьев. Любая пара (i, j) (1 ≤ i ≤ n; 1 ≤ j ≤ m) называется передачей и задает номера звездочек, на которых в данный момент закреплена цепь. Для передачи (i, j) передаточное число равно величине bj / ai.

Так как Васе нравятся целые числа, он хочет найти такие передачи (i, j), что их передаточные числа целые. С другой стороны, Васе нравится быстрая езда, поэтому среди всех «целочисленных» передач (i, j), он хочет выбрать передачи с максимальным передаточным числом. Помогите ему найти количество таких передач.

В задаче дробь bj / ai обозначает деление в вещественных числах, то есть округление не производится.
Входные данные

В первой строке входных данных записано целое число n (1 ≤ n ≤ 50) — количество звездочек на оси педалей велосипеда. Во второй строке записаны n целых чисел a1, a2, ..., an (1 ≤ ai ≤ 104) в порядке строгого возрастания.

В третьей строке входных данных записано целое число m (1 ≤ m ≤ 50) — количество звездочек на оси заднего колеса. В четвертой строке записаны m целых чисел b1, b2, ..., bm (1 ≤ bi ≤ 104) в порядке строгого возрастания.

Гарантируется, что существует хотя бы одна передача (i, j), что ее передаточное число — целое. Числа в строках разделяются пробелами.
Выходные данные

Выведите количество «целочисленных» передач, которые имеют максимальное значение передаточного числа среди всех «целочисленных» передач.

Примеры тестов
Входные данные

2
4 5
3
12 13 15

Выходные данные

2

Входные данные

4
1 2 3 4
5
10 11 12 13 14

Выходные данные

1

Примечание

В первом примере максимальное целое передаточное число равно 3. Существуют две передачи, которые имеют такое передаточное число. Для одной из них a1 = 4, b1 = 12, а для другой a2 = 5, b3 = 15.
-}

import Control.Applicative

solve a b = length [ 1 | aa <- a, bb <- b, bb `mod` aa == 0, bb `div` aa == mx ]
    where mx = foldl max 0 [ bb `div` aa | aa <- a, bb <- b, bb `mod` aa == 0 ]

main = do
  _ <- getLine
  a <- map read <$> (words <$> getLine)
  _ <- getLine
  b <- map read <$> (words <$> getLine)
  print $ solve a b

module Main where
import Control.Applicative
import Data.List
import Data.Function

main = do
    n <- readLn :: IO Int
    as <- map (read :: String -> Int) . words <$> getLine
    m <- readLn :: IO Int
    bs <- map (read :: String -> Int) . words <$> getLine
    print $ length $ maximumBy (compare `on` head) $ group $ sort [y`div`x | x<-as, y <-bs, y`mod`x==0]

import Prelude hiding (reads)

countMaximums :: [Int] -> Int
countMaximums []  =  0
countMaximums xs  =  length $ filter (== maximum xs) xs

solve :: [Int] -> [Int] -> Int
solve as bs  =  countMaximums [div b a | a <- as, b <- bs, mod b a == 0]

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

main :: IO ()
main  =  do
    as <- getLine >> reads
    bs <- getLine >> reads
    print $ solve as bs

import Data.List
import Data.Maybe
import Control.Monad
main = do
  getLine
  as <- fmap (map read . words) getLine
  getLine
  bs <- fmap (map read . words) getLine
  print $ length $ last $ group $ sort $ catMaybes $ liftM2 solve as bs
solve a b | r == 0    = Just q
          | otherwise = Nothing
    where (q,r) = b `divMod` a

import Data.List
import Data.Char

solve = length . head . group . reverse . sort
s2i = foldl t 0
        where t i c = i * 10 + digitToInt c

main = do
        ln <- getLine >> getLine >>= return . map s2i . words
        lm <- getLine >> getLine >>= return . map s2i . words
        let l = [ fst (j `quotRem` i) |  i <- ln, j <- lm, snd (j `quotRem` i) == 0  ] in
                print (solve l)

import Control.Applicative

main = do
  _ <- getLine
  as <- map read.words <$> getLine
  _ <- getLine
  bs <- map read.words <$> getLine
  let ints = [q|a<-as,b<-bs,let (q,r) = divMod b a,r==0]
  print $ length $ filter (maximum ints==) ints

import Data.List
main = do
    n <- read `fmap` getLine :: IO Int
    a <- (map read . words) `fmap` getLine
    m <- read `fmap` getLine :: IO Int
    b <- (map read . words) `fmap` getLine
    print $ length $ last $ group $ sort [x `div` y |  x <- b, y <- a, x `rem` y == 0]

import Data.List

solve :: ([Int], [Int]) -> Int
solve (xs, ys) = length . last . group $ sort [y `div` x | x <- xs, y <- ys, y `mod` x == 0]

readInput :: IO ([Int], [Int])
readInput = do
    contents <- getContents
    let n:ns:m:ms:_ = lines contents
        xs = map read $ take (read n) $ words ns
        ys = map read $ take (read m) $ words ms
    return (xs, ys)

showOutput :: Int -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

import Control.Monad

main :: IO ()
main = do
    n <- getLine
    ns <- fmap (map read . words) getLine :: IO [Int]
    m <- getLine
    ms <- fmap (map read . words) getLine :: IO [Int]

    let a = [div x y | x <- ms, y <- ns, mod x y == 0]

    print $ length $ filter (maximum a == ) a

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

parse = map (map read) . map words . lines

solve :: [[Int]] -> Int
solve [_, as, _, bs] =
  let
    bestRatio = maximum [b `div` a | b <- bs, a <- as, b `mod` a == 0]
  in
    length [8 | b <- bs, a <- as, b `mod` a == 0, b `div` a == bestRatio]

present = show

main = interact $ present . solve . parse

import Data.Maybe
import Control.Monad
main = do
  getLine
  as <- fmap (map read . words) getLine
  getLine
  bs <- fmap (map read . words) getLine
  print $ maximum $ catMaybes $ liftM2 solve as bs
solve a b | r == 0    = Just q
          | otherwise = Nothing
    where (q,r) = b `divMod` a

import Control.Monad

--main :: IO ()
main = do
    n <- getLine
    ns <- fmap (map read . words) getLine :: IO [Int]
    m <- getLine
    ms <- fmap (map read . words) getLine :: IO [Int]

    let a = [div x y | x <- ms, y <- ns, mod x y == 0]

    return $ length $ filter (maximum a == ) a


Polycarp has to solve exactly $$$n$$$ problems to improve his programming skill before an important programming competition. But this competition will be held very soon, most precisely, it will start in $$$k$$$ days. It means that Polycarp has exactly $$$k$$$ days for training!Polycarp doesn't want to procrastinate, so he wants to solve at least one problem during each of $$$k$$$ days. He also doesn't want to overwork, so if he solves $$$x$$$ problems during some day, he should solve no more than $$$2x$$$ problems during the next day. And, at last, he wants to improve his skill, so if he solves $$$x$$$ problems during some day, he should solve at least $$$x+1$$$ problem during the next day.More formally: let $$$[a_1, a_2, \dots, a_k]$$$ be the array of numbers of problems solved by Polycarp. The $$$i$$$-th element of this array is the number of problems Polycarp solves during the $$$i$$$-th day of his training. Then the following conditions must be satisfied:   sum of all $$$a_i$$$ for $$$i$$$ from $$$1$$$ to $$$k$$$ should be $$$n$$$;  $$$a_i$$$ should be greater than zero for each $$$i$$$ from $$$1$$$ to $$$k$$$;  the condition $$$a_i < a_{i + 1} \le 2 a_i$$$ should be satisfied for each $$$i$$$ from $$$1$$$ to $$$k-1$$$. Your problem is to find any array $$$a$$$ of length $$$k$$$ satisfying the conditions above or say that it is impossible to do it.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10^9, 1 \le k \le 10^5$$$) — the number of problems Polycarp wants to solve and the number of days Polycarp wants to train.

If it is impossible to find any array $$$a$$$ of length $$$k$$$ satisfying Polycarp's rules of training, print "NO" in the first line. Otherwise print "YES" in the first line, then print $$$k$$$ integers $$$a_1, a_2, \dots, a_k$$$ in the second line, where $$$a_i$$$ should be the number of problems Polycarp should solve during the $$$i$$$-th day. If there are multiple answers, you can print any.

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, FlexibleContexts, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Int
import Data.Array.ST.Safe
import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Maybe

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

s :: Int -> Int64
s n = div (n64 * pred n64) 2
  where
    n64 = fromIntegral n :: Int64

sNo = byteString $ C.pack "NO\n"
sYes = byteString $ C.pack "YES\n"

solve :: [Int] -> Builder
solve (n:k:_)
  | d < 0 || a0 < 1 = sNo
  | isNothing res = sNo
  | otherwise = sYes <> (mconcat $ intersperse (char7 ' ') $ map intDec (fromJust res)) <> char7 '\n'
  where
    n64 = fromIntegral n :: Int64
    sk = s k
    d = (n64 - sk)
    (a0, v) = divMod (fromIntegral d) k
    res = runST $ do
      x <- newListArray (1, k) $ map (+ a0) [0, 1 .. k - 1] :: ST s (STUArray s Int Int)
      let
        loop 1 0 = return True
        loop 1 _ = return False
        loop !i !r = do
          if (r > 0) then do
            a1 <- readArray x (pred i)
            a2 <- readArray x i
            let !delta = min (2 * a1 - a2) r
            writeArray x i (a2 + delta)
            loop (pred i) (r - delta)
          else return True
      b <- loop k v
      ans <- getElems x
      return $! if b then Just ans else Nothing

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


Doremy is asked to test $$$n$$$ contests. Contest $$$i$$$ can only be tested on day $$$i$$$. The difficulty of contest $$$i$$$ is $$$a_i$$$. Initially, Doremy's IQ is $$$q$$$. On day $$$i$$$ Doremy will choose whether to test contest $$$i$$$ or not. She can only test a contest if her current IQ is strictly greater than $$$0$$$.If Doremy chooses to test contest $$$i$$$ on day $$$i$$$, the following happens:   if $$$a_i>q$$$, Doremy will feel she is not wise enough, so $$$q$$$ decreases by $$$1$$$;  otherwise, nothing changes.  If she chooses not to test a contest, nothing changes.Doremy wants to test as many contests as possible. Please give Doremy a solution.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 10^4$$$) — the number of test cases. The description of the test cases follows. The first line contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n \le 10^5$$$, $$$1 \le q \le 10^9$$$) — the number of contests and Doremy's IQ in the beginning. The second line contains $$$n$$$ integers $$$a_1,a_2,\cdots,a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the difficulty of each contest. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, you need to output a binary string $$$s$$$, where $$$s_i=1$$$ if Doremy should choose to test contest $$$i$$$, and $$$s_i=0$$$ otherwise. The number of ones in the string should be maximum possible, and she should never test a contest when her IQ is zero or less. If there are multiple solutions, you may output any.

NoteIn the first test case, Doremy tests the only contest. Her IQ doesn't decrease.In the second test case, Doremy tests both contests. Her IQ decreases by $$$1$$$ after testing contest $$$2$$$.In the third test case, Doremy tests contest $$$1$$$ and $$$2$$$. Her IQ decreases to $$$0$$$ after testing contest $$$2$$$, so she can't test contest $$$3$$$.

module Main where

solve :: Integer -> [Integer] -> String
solve n a = reverse $ solve' 0 n (reverse a) where
  solve' _ _ [] = []
  solve' a b (x : xs)
    | x <= a = '1' : solve' a b xs
    | otherwise = if a < b then '1' : solve' (a + 1) b xs else '0' : solve' a b xs

for :: Integer -> IO () -> IO ()
for n action = if n == 1 then action else action *> for (n - 1) action

main = do
  times <- read <$> getLine
  for times $ do
    n <- (read . (!!1) . words) <$> getLine
    list <- fmap (read) <$> words <$> getLine
    putStrLn $ solve n list

--
-- 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,q],as] <- replicateM 2 ri
        return (q,as)
    mapM_ (putStrLn.solve) tcs

solve (q,as) = ans
  where
    minQs = reverse . tail . scanl nextQ 0 . reverse $ as
    ans = map snd . tail . scanl nextBit (q,'_') $ minQs `zip` as

nextQ q0 a1 | q0 >= a1   = q0
            | otherwise  = q0 +1

nextBit (q0,_) (mq,ai)
    | isF && isL  = (q0  , '0')
    | isF         = (q0  , '1')
    |        isL  = (q0-1, '1')
    | otherwise   = (q0  , '1')
  where
    isF = (q0 < mq)
    isL = (q0 < ai)


A binary string is a string that consists of characters $$$0$$$ and $$$1$$$. A bi-table is a table that has exactly two rows of equal length, each being a binary string.Let $$$\operatorname{MEX}$$$ of a bi-table be the smallest digit among $$$0$$$, $$$1$$$, or $$$2$$$ that does not occur in the bi-table. For example, $$$\operatorname{MEX}$$$ for $$$\begin{bmatrix} 0011\\ 1010 \end{bmatrix}$$$ is $$$2$$$, because $$$0$$$ and $$$1$$$ occur in the bi-table at least once. $$$\operatorname{MEX}$$$ for $$$\begin{bmatrix} 111\\ 111 \end{bmatrix}$$$ is $$$0$$$, because $$$0$$$ and $$$2$$$ do not occur in the bi-table, and $$$0 < 2$$$.You are given a bi-table with $$$n$$$ columns. You should cut it into any number of bi-tables (each consisting of consecutive columns) so that each column is in exactly one bi-table. It is possible to cut the bi-table into a single bi-table — the whole bi-table.What is the maximal sum of $$$\operatorname{MEX}$$$ of all resulting bi-tables can be?

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of the description of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of columns in the bi-table. Each of the next two lines contains a binary string of length $$$n$$$ — the rows of the bi-table. It's guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the maximal sum of $$$\operatorname{MEX}$$$ of all bi-tables that it is possible to get by cutting the given bi-table optimally.

NoteIn the first test case you can cut the bi-table as follows:  $$$\begin{bmatrix} 0\\ 1 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$2$$$. $$$\begin{bmatrix} 10\\ 10 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$2$$$. $$$\begin{bmatrix} 1\\ 1 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$0$$$. $$$\begin{bmatrix} 0\\ 1 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$2$$$. $$$\begin{bmatrix} 0\\ 0 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$1$$$. $$$\begin{bmatrix} 0\\ 0 \end{bmatrix}$$$, its $$$\operatorname{MEX}$$$ is $$$1$$$.The sum of $$$\operatorname{MEX}$$$ is $$$8$$$.

import Control.Monad
import Data.List

calc :: [(Char,Char)] -> Int
calc [] = 0
calc [('0','1')] = 2
calc [('1','0')] = 2
calc [('0','0')] = 1
calc [('1','1')] = 0
calc (('0','1'):xs) = 2+(calc xs)
calc (('1','0'):xs) = 2+(calc xs)
calc (('0','0'):('1','1'):xs) = 2+(calc xs)
calc (('0','0'):xs) = 1+(calc xs)
calc (('1','1'):('0','0'):xs) = 2+(calc xs)
calc (('1','1'):xs) = (calc xs)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    line1 <- getLine
    line2 <- getLine
    print $ calc $ zip line1 line2

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    getLine
    s <- transpose <$> sequence [getLine, getLine]
    let go ("01":xs)      = 2 + go xs
        go ("10":xs)      = 2 + go xs
        go ("00":"11":xs) = 2 + go xs
        go ("11":"00":xs) = 2 + go xs
        go ("00":xs)      = 1 + go xs
        go ("11":xs)      = go xs
        go ~[]            = 0
    print $ go s

main :: IO ()
main = readLn >>= flip replicateM_ solve

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 3 >>> map (tail >>> solve >>> show) >>> unlines

data State = SeenZero | SeenOne | None

solve :: [String] -> Int
solve [as, bs] = sum . map fst . scanl upd (0, None) $ zipWith val as bs ++ [3]
  where
    upd (_, st) v = compute v st

    compute 0 SeenZero = (1, SeenZero)
    compute 0 SeenOne  = (2, None)
    compute 0 None     = (0, SeenZero)
    compute 1 SeenZero = (2, None)
    compute 1 _        = (0, SeenOne)
    compute 2 SeenZero = (3, None)
    compute 2 _        = (2, None)
    compute _ SeenZero = (1, None)
    compute _ _        = (0, None)

    val '0' '0' = 0
    val '1' '1' = 1
    val _ _ = 2

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

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[_n] <- getInts 1
    ~[p, q] <- getNext 2
    let
      s = P.zip p q
      has tar (c1, c2) = elem tar [c1, c2]
      shouldCut :: Bool -> Bool -> (Char, Char) -> Bool
      shouldCut False _ _ = False
      shouldCut True False c = has '0' c
      shouldCut True True _ = True
      mex :: Bool -> Bool -> Int
      mex False _ = 0
      mex True False = 1
      mex True True = 2
      optCut = let
        go acc has0 has1 [] = acc + mex has0 has1
        go acc has0 has1 (c : cs) = if  shouldCut has0 has1 c
          then  go (acc + mex has0 has1) False False (c : cs)
          else  let
          (c1, c2) = c
          in  go acc
              (has0 || c1 == '0' || c2 == '0')
              (has1 || c1 == '1' || c2 == '1')
              cs
        in  go 0 False False
    pure $ putInts [optCut s]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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


DZY loves collecting special strings which only contain lowercase letters. For each lowercase letter c DZY knows its value wc. For each special string s = s1s2... s|s| (|s| is the length of the string) he represents its value with a function f(s), where Now DZY has a string s. He wants to insert k lowercase letters into this string in order to get the largest possible value of the resulting string. Can you help him calculate the largest possible value he could get?

The first line contains a single string s (1 ≤ |s| ≤ 103). The second line contains a single integer k (0 ≤ k ≤ 103). The third line contains twenty-six integers from wa to wz. Each such number is non-negative and doesn't exceed 1000.

Print a single integer — the largest possible value of the resulting string DZY could get.

NoteIn the test sample DZY can obtain "abcbbc", value = 1·1 + 2·2 + 3·2 + 4·2 + 5·2 + 6·2 = 41.

import Data.Char

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

solve :: [String] -> Int
solve (s:sk:sw) = let k = read sk
                      w = map read sw
                      i = snd . maximum $ zip w [0..]
                      c = chr (i + (ord 'a'))
                      f = s ++ (concat [[c] | r <- [1..k]])
                  in  solve' f 1 w
                  where
                      solve' :: String -> Int -> [Int] -> Int
                      solve' []     _ _ = 0
                      solve' (f:fs) i w = (w !! ((ord f) - (ord 'a'))) * i + (solve' fs (i + 1) w)

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

solve s k ws = sum $ zipWith (*) [1..] $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

dot [] _ = 0
dot _ [] = 0
dot (x:xs) (y:ys) = dot xs ys + x*y

calValue xs = dot xs [1..]

solve s k ws = calValue $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

init_val n [] mp  = 0
init_val n (c:str) mp =
  n * k + (init_val (n + 1) str mp)
  where k = fromJust $ Map.lookup c mp

main = do
  str <- getstr
  k <- getint
  values <- getints
  let mp = Map.fromList $ zip ['a'..'z'] values
      init = init_val 1 str mp
      len = length str
      mx = maximum values
      res = init + (sum $ map (* mx) [len + 1..len + k])
  putStrLn (show res)

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

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  w ++ (replicate k m)

import Data.Char (ord)
main :: IO ()
main = getLine >>= \s -> readLn >>= \k -> getContents >>= print . solve s k . map read . words

solve :: String -> Int -> [Int] -> Int
solve s k ws = sum $ zipWith (*) [1..length s + k] (map ((ws!!) . subtract (ord 'a') . ord) s ++ repeat (maximum ws))

import Data.Char
main=getLine>>= \s->getContents>>=print.f s.map read.words
f s (k:x)=sum$zipWith(*)[1..length s+k](map((x!!).subtract(ord 'a').ord)s++repeat(maximum x))

import Data.Char (ord)

main :: IO ()
main = getLine >>= \s -> readLn >>= \k -> getContents >>= print . solve s k . map read . words

solve :: String -> Int -> [Int] -> Int
solve s k ws = sum $ zipWith (*) [1..] (map (\c -> ws !! (ord c - ord 'a')) s ++ replicate k (maximum ws))

main = do
  s <- getLine
  k <- readLn
  ws <- map read . words <$> getLine
  let (_,best) = maximum (zip ws ['a'..])
  print $ sum $ zipWith (*) [1..] $
          map ((ws !!) . (subtract (fromEnum 'a') . fromEnum)) $
          s ++ replicate k best

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  xs <- map(\c->fromEnum c - 97).filter(\c->'a'<=c&&c<='z') <$> getLine
  k <- readLn
  arr <- listArray(0,25).map read.words <$> getLine
  print $ solve xs k arr

solve :: [Int] -> Int -> UArray Int Int -> Int
solve xs k arr =sum $ zipWith (\x i->unsafeAt arr x * i) xs [1..len] ++ map (wmax*) [len+1..len+k]
   where
     !len = length xs
     !wmax = maximum [unsafeAt arr i|i<-[0..25]]

q s(k:w)=sum$zipWith(*)[1..]$(map(\c->w!!(fromEnum c - fromEnum 'a'))s)++replicate k(maximum w)
z(s:l)=q s(map read l)
main=interact$show.z.words

import Data.Maybe
import Data.List
import Data.Function
import qualified Data.IntSet as IS
import Text.Printf (printf)
import Control.Monad

solve :: String -> Int -> [Int] -> Int
solve s k ws = f (s ++ replicate k c)
  where
    f s    = sum $ map (\(c, i) -> fromJust (lookup c alist) * i) (zip s [1..])
    alist  = zip ['a'..'z'] ws
    (c, w) = maximumBy (compare `on` snd) $ alist

main :: IO ()
main = do
  s <- getLine
  k <- readLn
  ws <- fmap (map read . words) getLine
  print $ solve s k ws

import Data.Char

main = interact $ show . sum . zipWith (*) [1..] . solve . words

solve par = (map (xs!!) $ map (subtract (ord 'a')) (map ord str) ) ++ (replicate k $ maximum xs)
    where str = head par
          k   = read $ par !! 1
          xs  = map read (drop 2 par)

import Data.Char

main = interact $ show . sum . zipWith (*) [1..] . sol . words

sol (s:k:xsp) = (map (\x -> xs !! (ord x - ord 'a')) s) ++ (replicate (read k) $ maximum xs)
    where xs = map read xsp

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

solve s k ws = zipWith (*) [1..] $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

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

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  sort $ init w ++ (replicate k m) ++ [last w]

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

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  sort $ w ++ (replicate k m)


You are given an array $$$a$$$ of $$$n$$$ integers, and another integer $$$k$$$ such that $$$2k \le n$$$.You have to perform exactly $$$k$$$ operations with this array. In one operation, you have to choose two elements of the array (let them be $$$a_i$$$ and $$$a_j$$$; they can be equal or different, but their positions in the array must not be the same), remove them from the array, and add $$$\lfloor \frac{a_i}{a_j} \rfloor$$$ to your score, where $$$\lfloor \frac{x}{y} \rfloor$$$ is the maximum integer not exceeding $$$\frac{x}{y}$$$.Initially, your score is $$$0$$$. After you perform exactly $$$k$$$ operations, you add all the remaining elements of the array to the score.Calculate the minimum possible score you can get.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Each test case consists of two lines. The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 100$$$; $$$0 \le k \le \lfloor \frac{n}{2} \rfloor$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$).

Print one integer — the minimum possible score you can get.

NoteLet's consider the example test.In the first test case, one way to obtain a score of $$$2$$$ is the following one:  choose $$$a_7 = 1$$$ and $$$a_4 = 2$$$ for the operation; the score becomes $$$0 + \lfloor \frac{1}{2} \rfloor = 0$$$, the array becomes $$$[1, 1, 1, 1, 3]$$$;  choose $$$a_1 = 1$$$ and $$$a_5 = 3$$$ for the operation; the score becomes $$$0 + \lfloor \frac{1}{3} \rfloor = 0$$$, the array becomes $$$[1, 1, 1]$$$;  choose $$$a_1 = 1$$$ and $$$a_2 = 1$$$ for the operation; the score becomes $$$0 + \lfloor \frac{1}{1} \rfloor = 1$$$, the array becomes $$$[1]$$$;  add the remaining element $$$1$$$ to the score, so the resulting score is $$$2$$$. In the second test case, no matter which operations you choose, the resulting score is $$$16$$$.In the third test case, one way to obtain a score of $$$0$$$ is the following one:  choose $$$a_1 = 1$$$ and $$$a_2 = 3$$$ for the operation; the score becomes $$$0 + \lfloor \frac{1}{3} \rfloor = 0$$$, the array becomes $$$[3, 7]$$$;  choose $$$a_1 = 3$$$ and $$$a_2 = 7$$$ for the operation; the score becomes $$$0 + \lfloor \frac{3}{7} \rfloor = 0$$$, the array becomes empty;  the array is empty, so the score doesn't change anymore. In the fourth test case, no operations can be performed, so the score is the sum of the elements of the array: $$$4 + 2 = 6$$$.

-- https://codeforces.com/contest/1618/problem/D
import Control.Monad (replicateM)
import Data.List (sort)

answer :: Int -> Int -> [Int] -> Int
answer n k l = sum (zipWith div numerators denominators) + sum remain where
    denominators = take k l
    numerators = take k $ drop k l
    remain = drop (2*k) l

main = getLine >>= flip replicateM run . read
run = do
    [n, k] <- (read <$>) . words <$> getLine
    numbers <- reverse . sort . (read <$>) . words <$> getLine
    print $ answer n k numbers

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

solve :: IO ()
solve = do
    ~[_, k] <- readInts
    xs <- readInts
    let xs' = reverse $ sort xs
        (as, xs'') = splitAt k xs'
        (bs, xs''') = splitAt k xs''
    print $ sum (map fromEnum $ zipWith (==) as bs) + sum xs'''

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

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


You are given an array $$$a$$$ consisting of $$$n$$$ integers.Let's call a pair of indices $$$i$$$, $$$j$$$ good if $$$1 \le i < j \le n$$$ and $$$\gcd(a_i, 2a_j) > 1$$$ (where $$$\gcd(x, y)$$$ is the greatest common divisor of $$$x$$$ and $$$y$$$).Find the maximum number of good index pairs if you can reorder the array $$$a$$$ in an arbitrary way.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of the test case contains a single integer $$$n$$$ ($$$2 \le n \le 2000$$$) — the number of elements in the array. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^5$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case, output a single integer — the maximum number of good index pairs if you can reorder the array $$$a$$$ in an arbitrary way.

NoteIn the first example, the array elements can be rearranged as follows: $$$[6, 3, 5, 3]$$$.In the third example, the array elements can be rearranged as follows: $$$[4, 4, 2, 1, 1]$$$.

{-# LANGUAGE TupleSections #-}
import Control.Monad ( replicateM_ )
import Data.List ( sortOn )

evensThenOdds = sortOn (`mod` 2)

pairs (x : xs) = map (x,) xs ++ pairs xs
pairs _ = []

maxGoodIndices :: [Int] -> Int
maxGoodIndices = length . filter isGood . pairs . evensThenOdds
    where isGood (a, b) = gcd a (2 * b) > 1

main = do n <- read <$> getLine
          replicateM_ n (getLine >> getLine >>= print . solve)
    where solve = maxGoodIndices . map read . words

import Control.Monad ( replicateM_ )

evens = filter even
odds = filter odd
evensThenOdds = (++) . evens <*> odds

pairsWith f (x : xs) = map (f x) xs ++ pairsWith f xs
pairsWith _ _ = []

maxGoodIndices :: [Int] -> Int
maxGoodIndices = length . filter id . pairsWith isGood . evensThenOdds
    where isGood a b = gcd a (2 * b) > 1

main = do n <- read <$> getLine
          replicateM_ n (getLine >> getLine >>= print . solve)
    where solve = maxGoodIndices . map read . words

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    print $ sum [1 | (x:ys) <- tails $ sortOn odd a, y <- ys, gcd x (2 * y) > 1]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    print $ sum $ [fromEnum $ gcd x (2 * y) > 1 | (x:ys) <- tails $ sortOn odd a, y <- ys]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

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

readInts = fmap (map read.words) getLine :: IO [Integer]
fori [x]  = 0
fori (x:xs) = forj x xs + fori xs

forj x [] = 0
forj x (y:xs) = forj x xs + if (gcd x (2*y) > 1) then 1 else 0

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let o = [x|x<-a, odd x]
        e = [x|x<-a, even x]
    let b = (reverse $ sort e) ++ (reverse $ sort o)
    print $ fori b

main = do
    t<-readLn :: IO Int
    replicateM_ t printS

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

solve a = length [ 1 | (x:rest) <- tails a , y <- rest, gcd x (2*y) > 1 ]

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- getLine
    a <- map read . words <$> getLine
    print $ solve $ filter even a ++ filter odd a

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))

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

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 2
         >>> map (last >>> words >>> map read >>> solve >>> show) >>> unlines

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

solve :: [Int] -> Int
solve xs = (`div` 2) $ count id [True | x <- xs, y <- xs, even x || even y || gcd x y > 1] - count (> 1) xs

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        BS.getLine
        xs <- sortOn (`mod` 2) . map parseInt . BS.words <$> BS.getLine
        print $ sum [1 | (x:ys) <- tails xs, y <- ys, gcd x (2*y) > 1]

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

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

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	getLine
	as <- readInts
	print $ sum $ do
		( a1, i ) <- zip as [ 0 .. ]
		( a2, j ) <- zip as [ 0 .. ]
		guard $ i < j
		return $ if 1 < gcd a1 a2 || ( a1 `mod` 2 == 0 || a2 `mod` 2 == 0 )
			then 1
			else 0

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- (\(s1, s2) -> s1 ++ s2) . partition even <$> getInts
    let ts = take n $ tails as
        result = sum[1 | (x : xs) <- ts, y <- xs, gcd x (2 * y) > 1]
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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

readInts = fmap (map read.words) getLine :: IO [Integer]
fori [x]  = 0
fori (x:xs) = forj x xs + fori xs

forj x [] = 0
forj x (y:xs) = forj x xs + if (gcd x (2*y) > 1) then 1 else 0

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let b = reverse $ sort a
    print $ fori b

main = do
    t<-readLn :: IO Int
    replicateM_ t printS


Binary Spiders are species of spiders that live on Mars. These spiders weave their webs to defend themselves from enemies.To weave a web, spiders join in pairs. If the first spider in pair has $$$x$$$ legs, and the second spider has $$$y$$$ legs, then they weave a web with durability $$$x \oplus y$$$. Here, $$$\oplus$$$ means bitwise XOR.Binary Spiders live in large groups. You observe a group of $$$n$$$ spiders, and the $$$i$$$-th spider has $$$a_i$$$ legs.When the group is threatened, some of the spiders become defenders. Defenders are chosen in the following way. First, there must be at least two defenders. Second, any pair of defenders must be able to weave a web with durability at least $$$k$$$. Third, there must be as much defenders as possible.Scientists have researched the behaviour of Binary Spiders for a long time, and now they have a hypothesis that they can always choose the defenders in an optimal way, satisfying the conditions above. You need to verify this hypothesis on your group of spiders. So, you need to understand how many spiders must become defenders. You are not a Binary Spider, so you decided to use a computer to solve this problem.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 3\cdot10^5$$$, $$$0 \le k \le 2^{30} - 1$$$), the amount of spiders in the group and the minimal allowed durability of a web. The second line contains $$$n$$$ integers $$$a_i$$$ ($$$0 \le a_i \le 2^{30}-1$$$) — the number of legs the $$$i$$$-th spider has.

In the first line, print a single integer $$$\ell$$$ ($$$2 \le \ell \le n$$$), the maximum possible amount of defenders. In the second line, print $$$\ell$$$ integers $$$b_i$$$, separated by a single space ($$$1 \le b_i \le n$$$) — indices of spiders that will become defenders. If there exists more than one way to choose the defenders, print any of them. Unfortunately, it may appear that it's impossible to choose the defenders. In this case, print a single integer $$$-1$$$.

NoteConsider the examples above.In the first example, the group of spiders is illustrated on the picture below:  We choose the two-legged, the ten-legged and the $$$16$$$-legged spiders. It's not hard to see that each pair may weave a web with enough durability, as $$$2 \oplus 10 = 8 \ge 8$$$, $$$2 \oplus 16 = 18 \ge 8$$$ and $$$10 \oplus 16 = 26 \ge 8$$$.This is not the only way, as you can also choose, for example, the spiders with indices $$$3$$$, $$$4$$$, and $$$6$$$.In the second example, no pair of spiders can weave the web with durability $$$1024$$$ or more, so the answer is $$$-1$$$.

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
              (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                (if ((length ll) == 2) then ll else
                  (if ((length rr) == 2) then rr else
                    (if ((length ll) == 1) then ll else
                      (if ((length rr) == 1) then rr else
                        (if (ar /= []) then [head ar] else
                          (if (bl /= []) then [head bl] else
                            (if (al /= []) then [head al] else
                              (if (br /= []) then [head br] else
                                []
                                  ))))))))))
           | otherwise = if (((length lr) == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))
    ll = (gg al bl k (div i 2))
    rr = (gg ar br k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.Bits
import Data.Foldable
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

data MaxLenList = MaxLenList { len :: !Int, vals :: [Int] }

instance Semigroup MaxLenList where
    a <> b = if len a >= len b then a else b

instance Monoid MaxLenList where
    mempty = MaxLenList 0 []

data Trie = Leaf { getList :: !MaxLenList }
          | Node { getList :: !MaxLenList, l_ :: Trie, r_ :: Trie }

addToList :: Int -> MaxLenList -> MaxLenList
addToList v (MaxLenList l vs) = MaxLenList (l + 1) (v:vs)

highestBit :: Int
highestBit = 29

empty :: Trie
empty = foldl' (const . join (Node mempty)) (Leaf mempty) [0..highestBit]

setMax :: Int -> MaxLenList -> Trie -> Trie
setMax x v' = go highestBit where
    go _ (Leaf v) = Leaf (v <> v')
    go i (Node v l r)
        | x `testBit` i = Node (v <> v') l              (go (i - 1) r)
        | otherwise     = Node (v <> v') (go (i - 1) l) r

getMax :: Int -> Int -> Trie -> MaxLenList
getMax k x = go highestBit where
    go _ (Leaf v) = v
    go i (Node _ l r) = case (k `testBit` i, x `testBit` i) of
        (False, False)  -> go (i - 1) l <> getList r
        (False, True)   -> getList l    <> go (i - 1) r
        (True,  False)  -> go (i - 1) r
        (True,  True)   -> go (i - 1) l

solve :: IO ()
solve = do
    ~[_, k] <- readInts
    as <- sort . flip zip [1 :: Int ..] <$> readInts
    let f t (ai, i) = (t', best) where
            best = addToList i $ getMax k ai t
            t' = setMax ai best t
        ans = foldMap' id $ snd $ mapAccumL f empty as
    putStr $ unlines $ if len ans >= 2
        then [show $ len ans, unwords $ map show $ vals ans]
        else ["-1"]

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

main :: IO ()
main = solve

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                 (if (ar /= []) then [head ar] else
                   (if (bl /= []) then [head bl] else
                     (if (al /= []) then [head al] else
                      (if (br /= []) then [head br] else
                        []
                          ))))))
           | otherwise = if (((length lr) == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                 (if (ar /= []) then [head ar] else
                   (if (bl /= []) then [head bl] else
                     (if (al /= []) then [head al] else
                      (if (br /= []) then [head br] else
                        []
                          ))))))
           | otherwise = if ((length lr == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if ((length lr == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (lr /= []) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] || b == []) = []
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (lr /= []) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] || b == []) = []
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (gl /= []) then gl else gr
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    gl = (gg al br k (div i 2))
    gr = (gg al br k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'


This problem is about imaginary languages BHTML and BCSS, which slightly resemble HTML and CSS. Read the problem statement carefully as the resemblance is rather slight and the problem uses very simplified analogs.You are given a BHTML document that resembles HTML but is much simpler. It is recorded as a sequence of opening and closing tags. A tag that looks like "<tagname>" is called an opening tag and a tag that looks like "</tagname>" is called a closing tag. Besides, there are self-closing tags that are written as "<tagname/>" and in this problem they are fully equivalent to "<tagname></tagname>". All tagnames in this problem are strings consisting of lowercase Latin letters with length from 1 to 10 characters. Tagnames of different tags may coincide.The document tags form a correct bracket sequence, that is, we can obtain an empty sequence from the given one using the following operations:   remove any self-closing tag "<tagname/>",  remove a pair of an opening and a closing tag that go consecutively (in this order) and have the same names. In other words, remove substring "<tagname></tagname>". For example, you may be given such document: "

" but you may not be given documents "", "", "" or "".Obviously, for any opening tag there is the only matching closing one — each such pair is called an element. A self-closing tag also is an element. Let's consider that one element is nested inside another one, if tags of the first element are between tags of the second one. An element is not nested to itself. For instance, in the example above element "b" is nested in "header" and in "p", but it isn't nested in "a" and "footer", also it isn't nested to itself ("b"). Element "header" has three elements nested in it, and "footer" has zero.We need the BCSS rules to apply styles when displaying elements of the BHTML documents. Each rule is recorded as a subsequence of words "x1 x2 ... xn". This rule has effect over all such elements t, which satisfy both conditions from the list:  there is a sequence of nested elements with tagnames "x1", "x2", ..., "xn" (that is, the second element is nested in the first one, the third element is nested in the second one and so on),  this sequence ends with element t (i.e. tagname of element t equals "xn"). For example, element "b" meets the conditions of the rule "a b" if for element "b" exists element "a" in which it is nested. Element "c" meets the conditions of the rule "a b b c", if three elements exist: "a", "b", "b", and in the chain "a"-"b"-"b"-"c" each following element is nested in the previous one.Given a BHTML document and a set of BCSS rules, write a program that determines the number of elements that meet the conditions of each rule.

The first line of the input contains a BHTML-document. The document has length from 4 to 106 characters. The document has a correct structure, doesn't contain spaces or any other unnecessary characters. Tagnames consist of lowercase Latin letters, their lengths are from 1 to 10 characters. The second line contains an integer m (1 ≤ m ≤ 200) — the number of queries. Then m lines contain the queries, one per line. Each query is a sequence x1, x2, ..., xn, where xi is the i-th element of the query, and n (1 ≤ n ≤ 200) is the number of elements in the query. The elements are separated by single spaces. Each query doesn't begin with and doesn't end with a space. Each query element is a sequence of lowercase Latin letters with length from 1 to 10.

Print m lines, the j-th line should contain the number of elements of the document that correspond to the j-th BCSS-rule. If there are no such elements at all, print on the line 0.

<b><aa/></b><aa><b/><b/></aa>
5
aa b
b
aa
b aa
a

import Data.List (foldl')
import Data.Bits (xor)
import qualified Data.Map as M

data Node = Node Int (M.Map Int Int) [Node]

split "" = []
split ('<':xs) = let (tag, '>':rest) = span ((/=) '>') xs in tag : split rest

hash :: String -> Int
hash = foldl' (\h c -> 33*h `xor` fromEnum c) 5381

parse = fst . process (Node 100500 M.empty []) . split
    where
        process parent@(Node name mp children) (tag:tags)
            | head tag == '/' = (parent, tags)
            | last tag == '/' = let ident = hash $ init tag
                                    child = Node ident (M.singleton ident 1) []
                                    newMap = M.insertWith' (+) ident 1 mp
                                in  process (Node name newMap (child:children)) tags
            | otherwise       = let ident = hash tag
                                    (child@(Node _ cmap _), rest) = process (Node ident (M.singleton ident 1) []) tags
                                    newMap = M.unionWith (+) mp cmap
                                in  process (Node name newMap (child:children)) rest
        process parent [] = (parent, [])

answer tree query = process tree $ map hash $ words query
    where
        process (Node _ mp _) [last] = M.findWithDefault 0 last mp
        process (Node name _ children) all@(tag:tags) =
            let tail = if name == tag then tags else all
            in  foldl' (\acc child -> acc + process child tail) 0 children

main = do
    line <- getLine
    let tree = parse line
    nstr <- getLine
    let n = read nstr
    queries <- mapM (\_ -> getLine) [1..n]
    mapM_ print $ (map (answer tree) queries)


Note that the memory limit is unusual.Let's define the sequence of Fibonacci strings as follows: $$$f_0$$$ is 0, $$$f_1$$$ is 1, $$$f_i$$$ is $$$f_{i-1} + f_{i-2}$$$ for $$$i>1$$$ ($$$+$$$ denotes the concatenation of two strings). So, for example, $$$f_2$$$ is 10, $$$f_3$$$ is 101, $$$f_4$$$ is 10110.For a given string $$$s$$$, let's define $$$g(s)$$$ as the number of ways to cut it into several (any number, possibly even just one) strings such that none of these strings are Fibonacci strings. For example, if $$$s$$$ is 10110101, $$$g(s) = 3$$$ since there are three ways to cut it:  101101 $$$+$$$ 01;  1011 $$$+$$$ 0101;  1011 $$$+$$$ 01 $$$+$$$ 01. You are given a sequence of strings $$$s_1, s_2, \dots, s_n$$$. Calculate $$$g(s_1), g(s_1 + s_2), \dots, g(s_1 + s_2 + \ldots + s_n)$$$. Since these values can be huge, print them modulo $$$998244353$$$.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 3 \cdot 10^3$$$). Then, $$$n$$$ lines follow. The $$$i$$$-th line contains the string $$$s_i$$$ ($$$1 \le |s_i| \le 10^3$$$), consisting of characters 0 and/or 1.

Print $$$n$$$ integers, where the $$$i$$$-th integer is $$$g(s_1 + s_2 + \ldots + s_i) \bmod 998244353$$$.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections, NumDecimals, MultiWayIf, BangPatterns  #-}
{-# LANGUAGE UnboxedTuples, MagicHash, DeriveLift, UnliftedNewtypes #-}
{-# LANGUAGE Strict, StrictData #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 -funfolding-use-threshold=0 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
-- {-# OPTIONS_GHC -O0 -funbox-strict-fields -fvia-C -optc-O0 #-}
#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.Ratio as R
import qualified Data.Traversable as T
import qualified Data.Foldable as F

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.Bits
import Data.Int

import System.IO (stdin, stdout, hFlush, stderr, BufferMode (NoBuffering), hSetBuffering)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
#endif

debug' x _ = x
trace' _ x = x
{-# INLINE tracing' #-}
tracing' _ x = x
debugging' x _ = x
traceM' _ = pure ()
{-# INLINE tracingM #-}
tracingM' _ _ = pure ()

#ifdef NDEBUG
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 = debug'
trace = trace'
tracing = tracing'
debugging = debugging'

traceM x = traceM' x
tracingM x y = tracingM' x y
#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

{- mod -}

m :: Int
m = 998_244_353
-- m = 10 ^ 9 + 7

newtype M = M { unM :: Int }
  deriving (Eq, Ord)

mI :: Integral a => a  -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)
    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

{- solution -}

type P = (Int, M)
type SolutionState = (Int, M, M, [P])

{-# INLINE fibChar #-}
fibChar :: Int -> Char
fibChar !idx = c
    where
        {-# INLINE c #-}
        !c = chr $ (cIdx .&. 1) + ord '0'
        !cIdx = {-# SCC cIdx #-}  F.foldl' update' idx rFibPairs

        {-# INLINE update' #-}
        update' :: Int -> (Int, Int) -> Int
        update' idx (f1, f2) = if f1 > 1 && idx > f1 && idx <= f2
            then idx - f1
            else idx

mx :: Int
mx = 3.3e6

fibPairs = zip fibs (L.tail fibs)
rFibPairs = tracing "rFibPairs".  reverse $ fibPairs

fibs :: [Int]
fibs = tracing "fibs" $ fibs'
    where
        fibs' :: [Int]
        fibs' = takeWhile (<= mx) $ 1 : 1 : zipWith (+) fibs' (tail fibs')

fibSet = IS.fromList fibs

fibMask :: UA.UArray Int Bool
fibMask = STA.runSTUArray $ do
    fibMask <- STA.newArray (1, mx) False
    M.forM_ [1 .. mx] $ \i -> do
        let ch = fibChar i
        MA.writeArray fibMask i $ ch == '1'
    return $ fibMask

solveStep :: (Monad m) => String -> MS.StateT SolutionState m M
solveStep str = do
    M.forM_ str $ \c -> do
        MS.modify $ \(len, sumCutCnt, cutCnt, fibSuffixes) -> flip MS.evalState [] $ do
            badCutCnt <- {-# SCC badCutCnt #-} M.liftM (tracing "badCutCnt") <$> (\t b m -> F.foldlM m b t) fibSuffixes 0 $ \sum p@(suffixPos, prevCnt) -> do
                let curSuffix = len - suffixPos + 1
                    fibC = if fibMask UA.! curSuffix then '1' else '0'

                {-# SCC globalIf #-} if  | curSuffix == 1 || (curSuffix > 1 && c == fibC) -> do
                                            {-# SCC insertP #-} M.when (c == '1' || curSuffix > 1) . MS.modify $ (p:)
                                            {-# SCC checkMember #-} return $ if (curSuffix `IS.member` fibSet) then prevCnt + sum else sum
                                         | otherwise -> return $ sum

            let curLen = len + 1
                curCutCnt = sumCutCnt - badCutCnt
                curSumCutCnt = sumCutCnt + curCutCnt

            {-# SCC mdfy #-} MS.modify $ (:) (curLen, curCutCnt)
            curFibSuffixes <- MS.get <&> tracing "curFibSuffixes"
            return (curLen, curSumCutCnt, curCutCnt, curFibSuffixes)

    (_, _, cnt, _) <- MS.get <&> tracing "state"
    return $ cnt

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    flip MS.evalStateT (0, M 1, M 0, [(0, M 1)]) $ do
        M.replicateM_ t $ do
            str <- MT.lift $ B8.getLine <&> B8.filter isAlphaNum
            M currentCutCnt <- solveStep $ B8.unpack str
            MT.lift $ printf "%lld\n" currentCutCnt

-- allCuts = allCuts + allCuts + 1
-- allCuts -= badCuts?
-- (........)/10110 => answer

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections, NumDecimals, MultiWayIf  #-}
{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 -funfolding-use-threshold=0 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
-- {-# OPTIONS_GHC -O0 -funbox-strict-fields -fvia-C -optc-O0 #-}
#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.Ratio as R
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.Bits
import Data.Int

import System.IO (stdin, stdout, hFlush, stderr, BufferMode (NoBuffering), hSetBuffering)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
#endif

debug' x _ = x
trace' _ x = x
{-# INLINE tracing' #-}
tracing' _ x = x
debugging' x _ = x
traceM' _ = pure ()
{-# INLINE tracingM #-}
tracingM' _ _ = pure ()

#ifdef NDEBUG
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 = debug'
trace = trace'
tracing = tracing'
debugging = debugging'

traceM x = traceM' x
tracingM x y = tracingM' x y
#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

{- mod -}

m :: Int
m = 998_244_353
-- m = 10 ^ 9 + 7

newtype M = M { unM :: Int }
  deriving (Eq, Ord)

mI :: Integral a => a  -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)
    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

{- solution -}

type SolutionState = (Int, M, M, [(Int, M)])

{-# INLINE fibChar #-}
fibChar :: Int -> Char
fibChar idx = c
    where
        c = chr $ (cIdx .&. 1) + ord '0'
        cIdx = L.foldl' update idx rFibPairs
        update idx (f1, f2)
            | f1 > 1 && idx > f1 && idx <= f2 = idx - f1
            | otherwise = idx

-- flip MS.evalState (tracing "idx" idx) $ do
--     M.forM_ rFibPairs $ \(f1, f2) -> do
--         (idx, _, _) <- MS.get <&> \idx -> tracing' "idx, f1, f2" (idx, f1, f2)
--         M.when (f1 > 1 && idx > f1 && idx <= f2) $ do
--             MS.modify' $ \s -> s - f1
--     MS.get <&> (\c -> chr $ (c .&. 1) + ord '0') <&> tracing "c"

fibPairs = zip fibs (L.tail fibs)
rFibPairs = reverse $ fibPairs

fibs :: [Int]
fibs = tracing "fibs" $ fibs'
    where
        fibs' :: [Int]
        fibs' = takeWhile (<= 3.3e6) $ 1 : 1 : zipWith (+) fibs' (tail fibs')

fibSet = IS.fromList fibs

solveStep :: (Monad m) => String -> MS.StateT SolutionState m M
solveStep str = do
    M.forM_ str $ \c -> do
        MS.modify $ \(len, sumCutCnt, cutCnt, fibSuffixes) -> flip MS.evalState [] $ do
            badCutCnt <- M.liftM (tracing "badCutCnt") <$> M.liftM L.sum <$> M.forM fibSuffixes $ \(suffixLength, prevCnt) -> do
                let curSuffix = suffixLength + 1
                    fibC = fibChar curSuffix

                if  | curSuffix >= 1 && c == fibC -> do
                        M.when (c == '1') . MS.modify $ (:) (curSuffix, prevCnt)
                        return $ if (curSuffix `IS.member` fibSet) then prevCnt else M 0
                    | otherwise -> return $ M 0

            let curLen = len + 1
                curCutCnt = sumCutCnt - badCutCnt
                curSumCutCnt = sumCutCnt + curCutCnt

            MS.modify $ (:) (0, curCutCnt)
            curFibSuffixes <- MS.get <&> tracing "curFibSuffixes"
            return (curLen, curSumCutCnt, curCutCnt, curFibSuffixes)

        (_, _, _, _) <- MS.get <&> tracing "state"
        return ()
    (_, _, cnt, _) <- MS.get <&> tracing "state"
    return $ cnt

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    flip MS.evalStateT (0, M 1, M 0, [(0, M 1)]) $ do
        M.replicateM_ t $ do
            str <- MT.lift $ B8.getLine <&> B8.filter isAlphaNum
            M currentCutCnt <- solveStep $ B8.unpack str
            MT.lift $ printf "%lld\n" currentCutCnt

-- allCuts = allCuts + allCuts + 1
-- allCuts -= badCuts?
-- (........)/10110 => answer