You are given array $$$a_1, a_2, \ldots, a_n$$$, consisting of non-negative integers.Let's define operation of "elimination" with integer parameter $$$k$$$ ($$$1 \leq k \leq n$$$) as follows:  Choose $$$k$$$ distinct array indices $$$1 \leq i_1 < i_2 < \ldots < i_k \le n$$$.  Calculate $$$x = a_{i_1} ~ \& ~ a_{i_2} ~ \& ~ \ldots ~ \& ~ a_{i_k}$$$, where $$$\&$$$ denotes the bitwise AND operation (notes section contains formal definition).  Subtract $$$x$$$ from each of $$$a_{i_1}, a_{i_2}, \ldots, a_{i_k}$$$; all other elements remain untouched. Find all possible values of $$$k$$$, such that it's possible to make all elements of array $$$a$$$ equal to $$$0$$$ using a finite number of elimination operations with parameter $$$k$$$. It can be proven that exists at least one possible $$$k$$$ for any array $$$a$$$.Note that you firstly choose $$$k$$$ and only after that perform elimination operations with value $$$k$$$ you've chosen initially.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 10^4$$$). Description of the test cases follows. The first line of each test case contains one integer $$$n$$$ ($$$1 \leq n \leq 200\,000$$$) — the length of array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i < 2^{30}$$$) — array $$$a$$$ itself. It's guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$200\,000$$$.

For each test case, print all values $$$k$$$, such that it's possible to make all elements of $$$a$$$ equal to $$$0$$$ in a finite number of elimination operations with the given parameter $$$k$$$. Print them in increasing order.

NoteIn the first test case:  If $$$k = 1$$$, we can make four elimination operations with sets of indices $$$\{1\}$$$, $$$\{2\}$$$, $$$\{3\}$$$, $$$\{4\}$$$. Since $$$\&$$$ of one element is equal to the element itself, then for each operation $$$x = a_i$$$, so $$$a_i - x = a_i - a_i = 0$$$.  If $$$k = 2$$$, we can make two elimination operations with, for example, sets of indices $$$\{1, 3\}$$$ and $$$\{2, 4\}$$$: $$$x = a_1 ~ \& ~ a_3$$$ $$$=$$$ $$$a_2 ~ \& ~ a_4$$$ $$$=$$$ $$$4 ~ \& ~ 4 = 4$$$. For both operations $$$x = 4$$$, so after the first operation $$$a_1 - x = 0$$$ and $$$a_3 - x = 0$$$, and after the second operation — $$$a_2 - x = 0$$$ and $$$a_4 - x = 0$$$.  If $$$k = 3$$$, it's impossible to make all $$$a_i$$$ equal to $$$0$$$. After performing the first operation, we'll get three elements equal to $$$0$$$ and one equal to $$$4$$$. After that, all elimination operations won't change anything, since at least one chosen element will always be equal to $$$0$$$.  If $$$k = 4$$$, we can make one operation with set $$$\{1, 2, 3, 4\}$$$, because $$$x = a_1 ~ \& ~ a_2 ~ \& ~ a_3 ~ \& ~ a_4$$$ $$$= 4$$$. In the second test case, if $$$k = 2$$$ then we can make the following elimination operations:  Operation with indices $$$\{1, 3\}$$$: $$$x = a_1 ~ \& ~ a_3$$$ $$$=$$$ $$$13 ~ \& ~ 25 = 9$$$. $$$a_1 - x = 13 - 9 = 4$$$ and $$$a_3 - x = 25 - 9 = 16$$$. Array $$$a$$$ will become equal to $$$[4, 7, 16, 19]$$$.  Operation with indices $$$\{3, 4\}$$$: $$$x = a_3 ~ \& ~ a_4$$$ $$$=$$$ $$$16 ~ \& ~ 19 = 16$$$. $$$a_3 - x = 16 - 16 = 0$$$ and $$$a_4 - x = 19 - 16 = 3$$$. Array $$$a$$$ will become equal to $$$[4, 7, 0, 3]$$$.  Operation with indices $$$\{2, 4\}$$$: $$$x = a_2 ~ \& ~ a_4$$$ $$$=$$$ $$$7 ~ \& ~ 3 = 3$$$. $$$a_2 - x = 7 - 3 = 4$$$ and $$$a_4 - x = 3 - 3 = 0$$$. Array $$$a$$$ will become equal to $$$[4, 4, 0, 0]$$$.  Operation with indices $$$\{1, 2\}$$$: $$$x = a_1 ~ \& ~ a_2$$$ $$$=$$$ $$$4 ~ \& ~ 4 = 4$$$. $$$a_1 - x = 4 - 4 = 0$$$ and $$$a_2 - x = 4 - 4 = 0$$$. Array $$$a$$$ will become equal to $$$[0, 0, 0, 0]$$$. Formal definition of bitwise AND:Let's define bitwise AND ($$$\&$$$) as follows. Suppose we have two non-negative integers $$$x$$$ and $$$y$$$, let's look at their binary representations (possibly, with leading zeroes): $$$x_k \dots x_2 x_1 x_0$$$ and $$$y_k \dots y_2 y_1 y_0$$$. Here, $$$x_i$$$ is the $$$i$$$-th bit of number $$$x$$$, and $$$y_i$$$ is the $$$i$$$-th bit of number $$$y$$$. Let $$$r = x ~ \& ~ y$$$ is a result of operation $$$\&$$$ on number $$$x$$$ and $$$y$$$. Then binary representation of $$$r$$$ will be $$$r_k \dots r_2 r_1 r_0$$$, where:$$$$$$ r_i = \begin{cases} 1, ~ \text{if} ~ x_i = 1 ~ \text{and} ~ y_i = 1 \\ 0, ~ \text{if} ~ x_i = 0 ~ \text{or} ~ y_i = 0 \end{cases} $$$$$$

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

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Data.Bits

factors :: Integral t => t -> [t]
factors n =  factors1 ++ go factors1 [] where
  factors1 = filter ((==0).mod n) $ takeWhile (\x->x*x<=n) [1..n]
  go [] ys = ys
  go (x:xs) ys = if x*x==n then ys else go xs $ n`div`x : ys

solve :: IO ()
solve = do
  ~[n] <- readv
  as <- readv
  let
    counts = [ DL.length $ DL.filter (`testBit` i) as | i<-[0..31]]
    g = foldr1 gcd counts
    gfacs = if g==0 then [1..n] else factors g
  printv gfacs

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

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

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve

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

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

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

data TC = TC {n :: Int, as :: [Int]}

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

type Output = [Int]

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

solve :: TC -> Output
solve TC {..} = filter ((== 0) . (g `mod`)) [1 .. n]
  where
    g = foldl1 gcd [countBy (`testBit` b) as | b <- [0 .. 29]]

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

import Data.Bits

countBits:: [Int] -> Int -> Int
countBits nums pos = length $ filter (\x -> x.&.(2^pos) > 0) nums
getNumBits nums = countBits nums <$> [0..29]
allDivisible n = all (\x -> x`mod`n == 0)
getPossibleCommonFactor nums = filter (`allDivisible` nums)
codeforceIntList = concatMap (\x->show x ++ " ")

run 0 = return 0
run t = do
    n <- getLine
    a <- getLine
    putStrLn $ codeforceIntList $ getPossibleCommonFactor (getNumBits $ read <$> words a) [1..read n]
    run $ t-1

main = getLine >>= run . read

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

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

main = do
    [t] <- readInts
    replicateM_ t $ do
        [n] <- readInts
        a <- readInts
        let ans = foldl' gcd 0 $ do
            i <- [0..29] :: [Int]
            return $ length $ filter id $ map (`testBit` i) a
        putStrLn $ unwords $ map show $ filter ((==0) . (ans `mod`)) [1..n]

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

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Data.Bits

factors :: Int->Int->[Int]
factors m n
  | m == 0 = [1..n]
  | otherwise = let
      cs = takeWhile (\i->i*i<=m) [1..m-1] ++ [m]
      fs = filter ((0==).mod m) cs
      in fs

solve :: IO ()
solve = do
  ~[n] <- readv
  as <- readv
  let
    counts = [ DL.length $ DL.filter (`testBit` i) as | i<-[0..31]]
    g = foldr1 gcd counts
    gfacs = if g==0 then [1..n] else factors g n
  printv gfacs

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

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

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve

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

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Data.Bits

factors :: Int->Int->[Int]
factors m n
  | m == 0 = [1..n]
  | otherwise = let
      cs = takeWhile (\i->i*i<=m) [1..m-1] ++ [m]
      fs = filter ((0==).mod m) cs
      in fs

solve :: IO ()
solve = do
  ~[n] <- readv
  as <- readv
  let
    counts = [ DL.length $ DL.filter (`testBit` i) as | i<-[0..31]]
    g = foldr1 gcd counts
    gfacs = if g==0 then [1..n] else filter (\x->g`mod`x==0) $ takeWhile (\x->x*x<=g) [1..g-1] ++ [g]
  printv gfacs

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

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

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve

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

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO
import Data.Bits

solve :: IO ()
solve = do
  ~[n] <- readv
  as <- readv
  let
    counts = [ DL.length $ DL.filter (`testBit` i) as | i<-[0..31]]
    g = foldr1 gcd counts
    gfacs = if g==0 then [1..n] else filter (\x->g`mod`x==0) $ takeWhile (\x->x*x<=g) [1..n-1] ++ [n]
  printv gfacs

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

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

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve


Last year the world's largest square was built in Berland. It is known that the square can be represented as an infinite plane with an introduced Cartesian system of coordinates. On that square two sets of concentric circles were painted. Let's call the set of concentric circles with radii 1, 2, ..., K and the center in the point (z, 0) a (K, z)-set. Thus, on the square were painted a (N, x)-set and a (M, y)-set. You have to find out how many parts those sets divided the square into.

The first line contains integers N, x, M, y. (1 ≤ N, M ≤ 100000,  - 100000 ≤ x, y ≤ 100000, x ≠ y).

main = do interact (show . gao . map read . words)
gao (n:x:m:y:_) = (if n + m < d then 1 else 2) + div (f n m + f m n) 2 where
	d = abs (x - y)
	f a b = let g c = if 1 <= c && c <= b then 1 else 0 in
		sum [2 * e - v |
			(l, r) <- map (\i -> (abs $ d - i, d + i)) [1 .. a],
			v <- [g l + g r + 2 * max 0 (min b (r-1) - max 1 (l+1) + 1)],
			e <- [max 1 v]]

main = interact solve
solve input = output where
  [n,x,m,y] = map (read::String->Integer) $ words input
  output = show $ answer l s
  d = abs (x-y)
  l = max n m
  s = min n m
  answer v w
    | d == 0             = v + 1
    | v + w <= d         = v + w + 1
    | v <= d             = v + w + 1 + (v+w-d)^2
    | v == w             = answer (v-1) (w-1) + 4*d
    | v <= w + d         = answer (v-1) w + 2*(w-v+d)+1
    | otherwise          = answer (v-1) w + 1

main = do interact (show . gao . map read . words)
gao (n:x:m:y:_) = 2 + div (f n m + f m n) 2 where
	d = abs (x - y)
	f a b = let g c = if 1 <= c && c <= b then 1 else 0 in
		sum [2 * e - v |
			(l, r) <- map (\i -> (abs $ d - i, d + i)) [1 .. a],
			v <- [g l + g r + 2 * max 0 (min b (r-1) - max 1 (l+1) + 1)],
			e <- [max 1 v]]

main = do interact (show . gao . map read . words)
gao (n:x:m:y:_) = 1 + n + m + sum [max 0 $ (min m (d+i) - max 1 (d-i)) * 2 + 1 | d <- [abs (x - y)], i <- [0 .. n - 1]]

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0         = max n m + 1
    | n+m <= d       = n + m + 1
    | n<=d && m<=d   = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n = n + m + 1 + 2*n^2 - (n-m+d)^2
    | n<=d           = n + m + 1 + 2*n^2
    | m<= d+n        = n + m + 1 + 2*(n-d)^2 - (n-d) + (d-n+d)^2 + (m-d)^2
    | otherwise      = n + m + 1 + 2*(n-d)^2 - (n-d) + (d-n+d)^2 + n^2

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + m + 1 + 2*n^2 - (n-m+d)^2
    | n<=d              = n + m + 1 + 2*n^2
    | m<= d+n           = n + m + 1 + d^2 + n^2 - (n-m+d)^2 + (n-d)^2 -(n-d)
    | otherwise         = n + m + 1 + d^2 + n^2             + (n-d)^2 -(n-d)

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + d + 1 + n^2 + n^2 - (n-m+d)^2
    | n<=d              = n + d + 1 + n^2 + n^2
    | m<= d+n           = n + 1 + d^2 + n^2 - (n-m+d)^2 + (n-d)^2 +(m-d)
    | otherwise         = n + 1 + d^2 + n^2             + (n-d)^2 +(m-d)
--n=1 m=5 d=4

main = interact solve
solve input = output where
  [n,x,m,y] = map (read::String->Int) $ words input
  output = show $ answer l s
  d = abs (x-y)
  l = max n m
  s = min n m
  answer v w
    | d == 0             = v + 1
    | v + w <= d         = v + w + 1
    | v <= d             = v + w + 1 + (v+w-d)^2
    | v == w             = answer (v-1) (w-1) + 4*d
    | v <= w + d         = answer (v-1) w + 2*(w-v+d)
    | otherwise          = answer (v-1) w + 1

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + m + 1 + (n+m-d)^2 + n^2 - (n-m+d)^2
    | n<=d              = n + m + 1 + (n+m-d)^2 + n^2
    | m<= d+n           = n + m + 1 + d^2 + n^2 - (n-m+d)^2 + (n-d)^2 -(n-d)
    | otherwise         = n + m + 1 + d^2 + n^2             + (n-d)^2 -(n-d)

main = interact solve
solve input = output where
  [n,x,m,y] = map (read::String->Int) $ words input
  output = show $ answer l s
  d = abs (x-y)
  l = max n m
  s = min n m
  answer v w
    | d == 0             = v + 1
    | v + w <= d         = v + w + 1
    | v <= d             = v + w + 1 + (v+w-d)^2
    | v == w             = answer (v-1) (w-1) + 4*d
    | v <= w + d         = answer (v-1) w + 2*(w-v+d)+1
    | otherwise          = answer (v-1) w + 1

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + m + 1 + n^2 + n^2 - (n-m+d)^2 - (m-d)
    | n<=d              = n + m + 1 + n^2 + n^2             - (m-d)
    | m<= d+n           = n + m + 1 + d^2 + n^2 - (n-m+d)^2 + (n-d)^2 -(n-d)
    | otherwise         = n + m + 1 + d^2 + n^2             + (n-d)^2 -(n-d)
--n=1 m=5 d=4

main = interact solve
solve input = output where
  [n,x,m,y] = map (read::String->Int) $ words input
  output = show $ answer l s
  d = abs (x-y)
  l = max n m
  s = min n m
  answer v w
    | d == 0             = v + 1
    | v + w <= d         = v + w + 1
    | v <= d             = v + w + 1 + (v+w-d)^2
    | v == w             = answer (v-1) (w-1) + 2*(2*d-1)
    | v <= w + d         = answer (v-1) w + 2*(w-v+d)
    | otherwise          = answer (v-1) w + 1

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + d + 1 + n^2 + n^2 - (n-m+d)^2
    | n<=d              = n + d + 1 + n^2 + n^2 + m-d-n
    | m<= d+n           = n + 1 + d^2 + n^2 - (n-m+d)^2 + (m-d)^2 - (m-n+d)^2
    | otherwise         = n + 1 + d^2 + n^2             + (m-d)^2 - (m-n+d)^2
--n=1 m=5 d=4

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + d + 1 + n^2 + n^2 - (n-m+d)^2
    | n<=d              = n + d + 1 + n^2 + n^2
    | m<= d+n           = n + 1 + d^2 + n^2 - (n-m+d)^2 + (m-d)^2 - (m-n+d)^2
    | otherwise         = n + 1 + d^2 + n^2             + (m-d)^2 - (m-n+d)^2
--n=1 m=5 d=4

main = interact solve
solve input = output where
  [p,x,q,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  n = min p q
  m = max p q
  answer
    | d == 0            = m + 1
    | n+m <= d          = n + m + 1
    | n<=d && m<=d      = n + m + 1 + (n+m-d)^2
    | n<=d && m<=d+n    = n + m + 1 + 2*n^2 - (n-m+d)^2
    | n<=d              = n + m + 1 + 2*n^2
    | m<= d+n           = n + m + 1 + (d-m)^2 + n^2 - (n-m+d)^2 + (n-d)^2 -(n-d)
    | otherwise         = n + m + 1 + (d-m)^2 + n^2             + (n-d)^2 -(n-d)

main = interact solve
solve input = output where
  [n,x,m,y] = map (read::String->Int) $ words input
  output = show answer
  d = abs (x - y)
  answer
    | d == 0    = max n m + 1
    | otherwise = ans (min n m) (max n m)
  ans u v
    | u+v<=d = u+v+1
    | u<=d && v<=d   = u+v+1+(u+v-d)^2
    | u<=d && v<=d+u = ans u d + u^2 - (u-v+d)^2
    | u<=d           = ans u (d+u) + v-d-u
    | u<=d+v         = ans d v + v^2 - (v-u+d)^2
    | otherwise      = ans (d+v) v + u-d-v


Polycarp found under the Christmas tree an array $$$a$$$ of $$$n$$$ elements and instructions for playing with it:   At first, choose index $$$i$$$ ($$$1 \leq i \leq n$$$) — starting position in the array. Put the chip at the index $$$i$$$ (on the value $$$a_i$$$).  While $$$i \leq n$$$, add $$$a_i$$$ to your score and move the chip $$$a_i$$$ positions to the right (i.e. replace $$$i$$$ with $$$i + a_i$$$).  If $$$i > n$$$, then Polycarp ends the game. For example, if $$$n = 5$$$ and $$$a = [7, 3, 1, 2, 3]$$$, then the following game options are possible:   Polycarp chooses $$$i = 1$$$. Game process: $$$i = 1 \overset{+7}{\longrightarrow} 8$$$. The score of the game is: $$$a_1 = 7$$$.  Polycarp chooses $$$i = 2$$$. Game process: $$$i = 2 \overset{+3}{\longrightarrow} 5 \overset{+3}{\longrightarrow} 8$$$. The score of the game is: $$$a_2 + a_5 = 6$$$.  Polycarp chooses $$$i = 3$$$. Game process: $$$i = 3 \overset{+1}{\longrightarrow} 4 \overset{+2}{\longrightarrow} 6$$$. The score of the game is: $$$a_3 + a_4 = 3$$$.  Polycarp chooses $$$i = 4$$$. Game process: $$$i = 4 \overset{+2}{\longrightarrow} 6$$$. The score of the game is: $$$a_4 = 2$$$.  Polycarp chooses $$$i = 5$$$. Game process: $$$i = 5 \overset{+3}{\longrightarrow} 8$$$. The score of the game is: $$$a_5 = 3$$$. Help Polycarp to find out the maximum score he can get if he chooses the starting index in an optimal way.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of the array $$$a$$$. The next line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — elements of the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output on a separate line one number — the maximum score that Polycarp can get by playing the game on the corresponding array according to the instruction from the statement. Note that Polycarp chooses any starting position from $$$1$$$ to $$$n$$$ in such a way as to maximize his result.

NoteThe first test case is explained in the statement.In the second test case, the maximum score can be achieved by choosing $$$i = 1$$$.In the third test case, the maximum score can be achieved by choosing $$$i = 2$$$.In the fourth test case, the maximum score can be achieved by choosing $$$i = 1$$$.

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

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             join, replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import           Data.Array                 as A
import           Data.Array.MArray.Safe     as MA
import           Data.Array.ST.Safe         as STA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace)
-- debug = flip trace

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

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

solve :: Int -> [Int] -> Int
solve n as = ST.runST $ do
    asArray <- STA.newListArray (1, n) as :: ST.ST s (STA.STUArray s Int Int)
    dpArray <- STA.newArray (1, n) 0 :: ST.ST s (STA.STUArray s Int Int)
    forM_ (reverse [1 .. n]) $ \i -> do
        a <- STA.readArray asArray i
        let incI = a + i
        if incI > n
            then STA.writeArray dpArray i a
            else do
                incDp <- STA.readArray dpArray incI
                STA.writeArray dpArray i $ incDp + a
    MA.getElems dpArray <&> maximum

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

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

import qualified Data.Array as A

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

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

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

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

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

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

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

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

solve :: Integer -> [Integer] -> Integer

solve n a = foldr max 0 tab where
	tab = A.array (0, n-1) $ fmap aux $ zip [0..] a
	aux (i, a_i)
		| i+a_i >= n = (i, a_i)
		| otherwise = (i, a_i + (tab ! (i+a_i)))

plotResult = print

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

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

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

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

solve :: [Int] -> Int
solve ns = maximum $ map snd $ M.toList $  M.foldrWithKey (\ k v m-> M.insert k (v + (if k+v<=n then m M.! (k+v) else 0)) m) z z where
  z = (M.fromList $ zip [1..] ns)
  n = length ns

import Data.Array
import Control.Monad

solve :: Array Int Int -> Int
solve inp = let
  (1, n) = bounds inp
  step i = let
    v = inp ! i
    in  v + if  v + i <= n  then  ansArr ! (v + i)  else  0
  ansArr = array (1, n) [(i, step i) | i <- [1..n]]
  in  maximum $ elems ansArr

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    let  inp = listArray (1, n) a
    print $ solve inp


Analyzing the mistakes people make while typing search queries is a complex and an interesting work. As there is no guaranteed way to determine what the user originally meant by typing some query, we have to use different sorts of heuristics.Polycarp needed to write a code that could, given two words, check whether they could have been obtained from the same word as a result of typos. Polycarpus suggested that the most common typo is skipping exactly one letter as you type a word.Implement a program that can, given two distinct words S and T of the same length n determine how many words W of length n + 1 are there with such property that you can transform W into both S, and T by deleting exactly one character. Words S and T consist of lowercase English letters. Word W also should consist of lowercase English letters.

The first line contains integer n (1 ≤ n ≤ 100 000) — the length of words S and T. The second line contains word S. The third line contains word T. Words S and T consist of lowercase English letters. It is guaranteed that S and T are distinct words.

Print a single integer — the number of distinct words W that can be transformed to S and T due to a typo.

NoteIn the first sample test the two given words could be obtained only from word "treading" (the deleted letters are marked in bold).In the second sample test the two given words couldn't be obtained from the same word by removing one letter.In the third sample test the two given words could be obtained from either word "tory" or word "troy".

main = do
    getLine
    s <- getLine
    t <- getLine
    let (s', t') = unzip $ reverse $ dropWhile (uncurry (==))
                         $ reverse $ dropWhile (uncurry (==)) $ zip s t
    if length s' == 1 then
      print 2
    else
      print $ fromEnum (init s' == tail t') + fromEnum (init t' == tail s')


It was recycling day in Kekoland. To celebrate it Adil and Bera went to Central Perk where they can take bottles from the ground and put them into a recycling bin.We can think Central Perk as coordinate plane. There are n bottles on the ground, the i-th bottle is located at position (xi, yi). Both Adil and Bera can carry only one bottle at once each. For both Adil and Bera the process looks as follows:   Choose to stop or to continue to collect bottles.  If the choice was to continue then choose some bottle and walk towards it.  Pick this bottle and walk to the recycling bin.  Go to step 1. Adil and Bera may move independently. They are allowed to pick bottles simultaneously, all bottles may be picked by any of the two, it's allowed that one of them stays still while the other one continues to pick bottles.They want to organize the process such that the total distance they walk (the sum of distance walked by Adil and distance walked by Bera) is minimum possible. Of course, at the end all bottles should lie in the recycling bin.

First line of the input contains six integers ax, ay, bx, by, tx and ty (0 ≤ ax, ay, bx, by, tx, ty ≤ 109) — initial positions of Adil, Bera and recycling bin respectively. The second line contains a single integer n (1 ≤ n ≤ 100 000) — the number of bottles on the ground. Then follow n lines, each of them contains two integers xi and yi (0 ≤ xi, yi ≤ 109) — position of the i-th bottle. It's guaranteed that positions of Adil, Bera, recycling bin and all bottles are distinct.

Print one real number — the minimum possible total distance Adil and Bera need to walk in order to put all bottles into recycling bin. Your answer will be considered correct if its absolute or relative error does not exceed 10 - 6. Namely: let's assume that your answer is a, and the answer of the jury is b. The checker program will consider your answer correct if .

NoteConsider the first sample.Adil will use the following path: .Bera will use the following path: .Adil's path will be  units long, while Bera's path will be  units long.

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

type Pos = (Double, Double)

main = do
  [ax, ay, bx, by, tx, ty] <- fmap (map read . words) getLine
  n <- fmap read getLine
  inp <- forM [1..n] $ \_ -> do
        [px, py]  <- fmap (map read . words) getLine
        return (px, py)
  print $ solve (ax, ay) (bx, by) (tx, ty) inp

--solve :: Pos -> Pos -> Pos -> [Pos] -> Double
solve a b r [p] = minimum [as, bs]
    where
      as = sub a p + sub p r
      bs = sub b p + sub p r
solve a b r s = sumTs - maximum [onlyA, onlyB, aNb]
    where
      sumTs = 2*sum (map h s)
          where
            h p = sub r p

      f p = sub p r - sub a p
      g p = sub p r - sub b p
      (ma:ma':as) = sortBy (flip compare) (zip (map f s) [0..])
      (mb:mb':bs) = sortBy (flip compare) (zip (map g s) [0..])
      aNb | snd ma == snd mb = maximum [fst ma + fst mb', fst ma' + fst mb]
          | otherwise = fst ma + fst mb
      onlyA = fst ma
      onlyB = fst mb

sub (x, x') (y,y') = sqrt $ (x - y)**2 + (x'- y')**2

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

main = do
  [ax,ay,bx,by,tx,ty] <- map read.words <$> getLine :: IO [Integer]
  n <- readLn
  xys <- parse.map readInt.B.words <$> B.getContents
  print $ solve n (ax,ay) (bx,by) (tx,ty) xys

solve 1 axy bxy txy [xy] = minimum [dist axy xy+dist txy xy, dist bxy xy+dist txy xy]
solve n axy bxy txy xys = minimum $ [calc1 axy, calc1 bxy] ++ [calc2 a b|(a,b)<-[(a1,b1),(a2,b1),(a1,b2)], a /= b]
  where
    (a1:a2:_) = map snd $ sort[(dist axy xy - dist txy xy, xy)|xy<-xys]
    (b1:b2:_) = map snd $ sort[(dist bxy xy - dist txy xy, xy)|xy<-xys]

    !s = 2*sum[dist txy xy |xy<-xys]
    calc1 a0 = s + minimum[dist a0 xy - dist txy xy|xy<-xys]
    calc2 a1 b1 = s + (dist axy a1 - dist txy a1) + (dist bxy b1 - dist txy b1)

dist2 (a,b) (c,d) = (a-c)^2 + (b-d)^2

dist x y = intSqrt $ dist2 x y

intSqrt :: Integer -> Double
intSqrt = sqrt.fromIntegral

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

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

import qualified Data.ByteString as B
import Data.List

dist (x,y) (x1,y1) = sqrt $ (x-x1)*(x-x1) + (y-y1)*(y-y1)

calcTotal t pts = 2 * (sum $ map (dist t) pts)

calcDiffs t a pts = sort $ map diff pts `zip` [1..]
  where diff p = (dist a p) - (dist t p)

main = interact $ show . solve . words

pairs [] = []
pairs (x:y:r) = (x,y) : pairs r

solve wrds = solve0 a b t n pts
  where [a, b, t] = pairs . map read . take 6 $ wrds :: [(Double, Double)]
        n = read $ wrds !! 6 :: Int
        pts = pairs . map read . take (2*n) . drop 7 $ wrds :: [(Double, Double)]

solve0 a b t n pts = minimum better + calcTotal t pts
  where [adf, bdf] = [take 5 $ calcDiffs t a pts, take 5 $ calcDiffs t b pts]
        [af, bf] = [fst . head $ adf, fst . head $ bdf]
        better = af : bf : [fst i + fst j | i <- adf, j <- bdf, snd i /= snd j]

import Data.List

dist (x,y) (x1,y1) = sqrt $ (x-x1)*(x-x1) + (y-y1)*(y-y1)

calcTotal t pts = 2 * (sum $ map (dist t) pts)

calcDiffs t a pts = sort $ map diff pts `zip` [1..]
  where diff p = (dist a p) - (dist t p)

main = do
    [ax,ay,bx,by,tx,ty] <- fmap (map (read :: String -> Double) . words) $ getLine
    let [a,b,t] = [(ax, ay), (bx, by), (tx, ty)]
    n <- fmap (read :: String -> Int) getLine
    let readPts i
         | i == 0 = return []
         | otherwise = do
             [x,y] <- fmap (map (read :: String -> Double) . words) $ getLine
             fmap ((x,y):) $ readPts (i - 1)
    pts <- readPts n
    let adiffs = calcDiffs t a pts
    let bdiffs = calcDiffs t b pts
    let [bra, brb] = [take 5 adiffs, take 5 bdiffs]
    let [af, bf] = [fst . head $ adiffs, fst . head $ bdiffs]
    let res = af : bf : [fst i + fst j | i <- bra, j <- brb, snd i /= snd j]
    print $ minimum res + calcTotal t pts

import Data.List
import Data.Functor

main :: IO()
main = do
    [ax, ay, bx, by, tx, ty] <- map read . words <$> getLine
    n <- read <$> getLine
    d <- split . map read . words <$> getContents
    let ad = map (dist (ax, ay)) d
        bd = map (dist (bx, by)) d
        td = map (dist (tx, ty)) d
        total = 2 * sum td
        af = [x - y | (x, y) <- zip ad td]
        bf = [x - y | (x, y) <- zip bd td]
        asd = sort $ zip af [0..]
        bsd = sort $ zip bf [0..]
        minA = fst $ head asd
        minB = fst $ head bsd
        minAB = min2 n asd bsd
        minBA = min2 n bsd asd
    print $ total + minimum [minA, minB, minAB, minBA]

split :: [a] -> [(a, a)]
split [] = []
split (x:y:s) = (x, y) : split s

square :: Double -> Double
square x = x * x

dist :: (Double, Double) -> (Double, Double) -> Double
dist (x1, y1) (x2, y2) = sqrt (square (x1 - x2) + square (y1 - y2))

min2 :: Int -> [(Double, Int)] -> [(Double, Int)] -> Double
min2 n a b | n == 1 = fst $ head a
           | snd (head a) == snd (head b) = fst (head a) + fst (head $ tail b)
           | otherwise = fst (head a) + fst (head b)


Everyone knows that agents in Valorant decide, who will play as attackers, and who will play as defenders. To do that Raze and Breach decided to play $$$t$$$ matches of a digit game...In each of $$$t$$$ matches of the digit game, a positive integer is generated. It consists of $$$n$$$ digits. The digits of this integer are numerated from $$$1$$$ to $$$n$$$ from the highest-order digit to the lowest-order digit. After this integer is announced, the match starts.Agents play in turns. Raze starts. In one turn an agent can choose any unmarked digit and mark it. Raze can choose digits on odd positions, but can not choose digits on even positions. Breach can choose digits on even positions, but can not choose digits on odd positions. The match ends, when there is only one unmarked digit left. If the single last digit is odd, then Raze wins, else Breach wins.It can be proved, that before the end of the match (for every initial integer with $$$n$$$ digits) each agent has an ability to make a turn, i.e. there is at least one unmarked digit, that stands on a position of required parity.For each of $$$t$$$ matches find out, which agent wins, if both of them want to win and play optimally.

First line of input contains an integer $$$t$$$ $$$(1 \le t \le 100)$$$  — the number of matches. The first line of each match description contains an integer $$$n$$$ $$$(1 \le n \le 10^3)$$$  — the number of digits of the generated number. The second line of each match description contains an $$$n$$$-digit positive integer without leading zeros.

For each match print $$$1$$$, if Raze wins, and $$$2$$$, if Breach wins.

NoteIn the first match no one can make a turn, the only digit left is $$$2$$$, it's even, so Breach wins.In the second match the only digit left is $$$3$$$, it's odd, so Raze wins.In the third match Raze can mark the last digit, after that Breach can only mark $$$0$$$. $$$1$$$ will be the last digit left, it's odd, so Raze wins.In the fourth match no matter how Raze plays, Breach can mark $$$9$$$, and in the end there will be digit $$$0$$$. It's even, so Breach wins.

import Control.Monad

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

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

solve :: Int -> String -> Int
solve n s
  | even n =if any even evens then 2 else 1
  | otherwise = if any odd odds then 1 else 2
  where
    zipped = zip s [1::Int ..]
    evens = map ((\x -> read [x]) .fst) $ filter (even.snd) zipped
    odds = map ((\x -> read [x]) .fst) $ filter (odd.snd) zipped

import Data.List
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int]
readArray = do
    line <- getLine
    return $ map (read::String->Int) $ words line

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

everySnd :: [a] -> [a]
everySnd lst = map fst $ filter (even.snd) indexed where
    indexed = zip lst [0..]

everyOdd:: [a] -> [a]
everyOdd lst = map fst $ filter (odd.snd) indexed where
    indexed = zip lst [0..]

solveAlice :: String -> IO ()
solveAlice s = do
    let snd = (everySnd s)
    let answer = any (\x -> (digitToInt x) `mod` 2 == 1) snd
    if answer then print 1 else print 2

solveBob :: String -> IO ()
solveBob s = do
    let snd = (everyOdd s)
    let answer = any (\x -> (digitToInt x) `mod` 2 == 0) snd
    if answer then print 2 else print 1

solve :: IO ()
solve = do
    n <- readInt
    s <- getLine
    if n `mod` 2 == 1 then (solveAlice s) else (solveBob s)

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)

import Control.Monad

parts :: [Int] -> ([Int], [Int])
parts [] = ([], [])
parts (x:y:zs) = let
  (xs, ys) = parts zs
  in  (x : xs, y : ys)
parts li = (li, [])

solve :: [Int] -> Bool
solve li = let  (lo, le) = parts li
  in  if  even (length li)
  then  all odd le
  else  any odd lo

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    a <- map (read . pure) <$> getLine
    putStrLn $ case  solve a  of
      True -> "1"
      False -> "2"

import Control.Monad
import Data.Char
main = do
  t <- fmap read getLine
  forM [1..t] (\_ -> do
    n <- fmap read getLine
    ans <- fmap (calc n) getLine
    print ans)
calc :: Int -> String -> Int
calc n d
  | odd n = calc1 d
  | even n = calc2 d
calc1 [x] = if odd $ digitToInt x then 1 else 2
calc1 (x:y:xs) = if odd $ digitToInt x then 1 else calc1 xs
calc2 [x,y] = if even $ digitToInt y then 2 else 1
calc2 (x:y:xs) = if even $ digitToInt y then 2 else calc2 xs

import Data.List
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int]
readArray = do
    line <- getLine
    return $ map (read::String->Int) $ words line

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

everySnd :: [a] -> [a]
everySnd lst = map fst $ filter (even.snd) indexed where
    indexed = zip lst [0..]

solve :: IO ()
solve = do
    s <- getLine
    s <- getLine
    let snd = (everySnd s)
    let answer = any (\x -> (digitToInt x) `mod` 2 == 1) snd
    if answer then print 1 else print 2

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)

import Control.Monad
import Data.Char
main = do
  t <- fmap read getLine
  forM [1..t] (\_ -> do
    n <- fmap read getLine
    ans <- fmap (calc n) getLine
    print ans)
calc :: Int -> String -> Int
calc n d
  | odd n = calc1 d
  | even n = calc2 d
calc1 [x] = if odd $ digitToInt x then 1 else 2
calc1 (x:y:xs) = if odd $ digitToInt x then 1 else calc1 xs
calc2 [x,y] = if even $ digitToInt x then 2 else 1
calc2 (x:y:xs) = if even $ digitToInt x then 2 else calc2 xs

import Control.Monad
main = do
  t <- fmap read getLine
  forM [1..t] (\_ -> do
    n <- fmap read getLine
    ans <- fmap ((calc n).read) getLine
    print ans)
calc :: Int -> Int -> Int
calc n d
  | odd n = calc1 d
  | even n = calc2 d
calc1 d
  | d < 100 = if odd d then 1 else 2
  | otherwise = if odd d then 1 else calc1 $ div d 100
calc2 d
  | d < 100 = if even $ div d 10 then 2 else 1
  | otherwise = if even $ div d 10 then 2 else calc2 $ div d 100


You are given $$$n$$$ strings $$$s_1, s_2, \dots, s_n$$$ of length at most $$$\mathbf{8}$$$. For each string $$$s_i$$$, determine if there exist two strings $$$s_j$$$ and $$$s_k$$$ such that $$$s_i = s_j + s_k$$$. That is, $$$s_i$$$ is the concatenation of $$$s_j$$$ and $$$s_k$$$. Note that $$$j$$$ can be equal to $$$k$$$.Recall that the concatenation of strings $$$s$$$ and $$$t$$$ is $$$s + t = s_1 s_2 \dots s_p t_1 t_2 \dots t_q$$$, where $$$p$$$ and $$$q$$$ are the lengths of strings $$$s$$$ and $$$t$$$ respectively. For example, concatenation of "code" and "forces" is "codeforces".

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the number of strings. Then $$$n$$$ lines follow, the $$$i$$$-th of which contains non-empty string $$$s_i$$$ of length at most $$$\mathbf{8}$$$, consisting of lowercase English letters. Among the given $$$n$$$ strings, there may be equal (duplicates). The sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, output a binary string of length $$$n$$$. The $$$i$$$-th bit should be $$$\texttt{1}$$$ if there exist two strings $$$s_j$$$ and $$$s_k$$$ where $$$s_i = s_j + s_k$$$, and $$$\texttt{0}$$$ otherwise. Note that $$$j$$$ can be equal to $$$k$$$.

3

5

abab

ab

abc

abacb

c

3

x

xx

xxx

8

codeforc

es

codes

cod

forc

forces

e

code

NoteIn the first test case, we have the following:   $$$s_1 = s_2 + s_2$$$, since $$$\texttt{abab} = \texttt{ab} + \texttt{ab}$$$. Remember that $$$j$$$ can be equal to $$$k$$$.  $$$s_2$$$ is not the concatenation of any two strings in the list.  $$$s_3 = s_2 + s_5$$$, since $$$\texttt{abc} = \texttt{ab} + \texttt{c}$$$.  $$$s_4$$$ is not the concatenation of any two strings in the list.  $$$s_5$$$ is not the concatenation of any two strings in the list.  Since only $$$s_1$$$ and $$$s_3$$$ satisfy the conditions, only the first and third bits in the answer should be $$$\texttt{1}$$$, so the answer is $$$\texttt{10100}$$$.

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

-- road map in reverse, and the number of cities, init pen state
type Domain = [String]
type CoDomain = [Int]
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ concatMap show xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- replicateM n getLine
  return xs

data Trie = Leaf | Node Bool (Map Char Trie)

toTrie :: [Char] -> Trie
toTrie [] = Leaf
toTrie (x:xs) = Node False (Map.singleton x (toTrie xs))

addTrie :: [Char] -> Trie -> Trie
addTrie [] Leaf = Leaf
addTrie [] (Node _ xs) = Node True xs
addTrie (x:xs) Leaf = Node True (Map.singleton x (toTrie xs))
addTrie (x:xs) (Node b children) = Node b (alter f x children)
  where f Nothing = Just $ toTrie xs
        f (Just t) = Just $ addTrie xs t

inTrie :: [Char] -> Trie -> Bool
inTrie [] Leaf = True
inTrie [] (Node x _) = x
inTrie (x:xs) Leaf = False
inTrie (x:xs) (Node b children) = case Map.lookup x children of
    Nothing -> False
    Just child -> inTrie xs child

buildTrie :: [String] -> Trie
buildTrie xs = foldl (flip addTrie) Leaf xs

solve :: Solver
solve xs = [if r then 1 else 0 | r <- res ]
  where
   ys = buildTrie xs
   f = (`inTrie` ys)
   res =  (\y -> any (\(a,b) -> f a && f b) $ (flip splitAt y) <$> [1..length y - 1]) <$> xs

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

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

-- road map in reverse, and the number of cities, init pen state
type Domain = [String]
type CoDomain = [Int]
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ concatMap show xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- replicateM n getLine
  return xs

data Trie = Leaf | Node Bool (Map Char Trie)

toTrie :: [Char] -> Trie
toTrie [] = Leaf
toTrie (x:xs) = Node False (Map.singleton x (toTrie xs))

addTrie :: [Char] -> Trie -> Trie
addTrie [] Leaf = Leaf
addTrie [] (Node _ xs) = Node True xs
addTrie (x:xs) Leaf = Node True (Map.singleton x (toTrie xs))
addTrie (x:xs) (Node b children) = Node b (alter f x children)
  where f Nothing = Just $ toTrie xs
        f (Just t) = Just $ addTrie xs t

inTrie :: [Char] -> Trie -> Bool
inTrie [] Leaf = True
inTrie [] (Node x _) = x
inTrie (x:xs) Leaf = False
inTrie (x:xs) (Node b children) = case Map.lookup x children of
    Nothing -> False
    Just child -> inTrie xs child

buildTrie :: [String] -> Trie
buildTrie xs = foldr addTrie Leaf xs

solve :: Solver
solve xs = [if r then 1 else 0 | r <- res ]
  where
   ys = buildTrie xs
   f = (`inTrie` ys)
   res =  (\y -> any (\(a,b) -> f a && f b) $ (flip splitAt y) <$> [1..length y - 1]) <$> xs

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

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \r\n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []
readInt :: BS.ByteString -> Int
readInt line = let [x] = readInts line in x

solve :: [BS.ByteString] -> [Bool]
solve strs = map check strs
    where set :: S.Set BS.ByteString
          set = foldr S.insert S.empty strs
          check :: BS.ByteString -> Bool
          check str = or [check' i str | i <- [1 .. BS.length str - 1]]
          check' :: Int -> BS.ByteString -> Bool
          check' i str = S.member (BS.take i str) set && S.member (BS.drop i str) set

printSolution :: [Bool] -> IO ()
printSolution soln = putStrLn $ map (\x -> if x then '1' else '0') soln

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- readInt <$> BS.getLine
                    strs <- map (BS.filter (/='\r')) <$> forM [1 .. n] (\x -> BS.getLine)
                    printSolution (solve strs)

main :: IO ()
main = do t <- readInt <$> BS.getLine
          forM_ [1 .. t] testCaseMain

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

check :: String -> String -> Set.Set String -> Bool
check "" suff set = False
check pref suff set =
    if suff /= "" && Set.member pref set && Set.member suff set
    then True
    else check (init pref) ((last pref) : suff) set

solve :: [String] -> [Bool]
solve strs =
    map (\x -> check x "" set) strs
    where set = Set.fromList strs

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    strs <- forM [1..n] (\x -> getLine)
    putStrLn $ filter (\x -> x /= ' ') $ unwords $ map (\x -> if x then "1" else "0") $ solve strs
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

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

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import Data.Array ((!))
import Data.Array.ST (MArray (newArray), readArray, runSTArray, writeArray)
import qualified Data.ByteString.Char8 as C
import Data.Char (toLower)
import Data.List (nub, sort)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Debug.Trace (traceShowId, traceShow)

data TC = TC {ss :: [String]}

solve TC {..} = fmap (\case True -> '1'; _ -> '0') $ fmap check ss
  where
    allSet = Set.fromList ss

    prefixes = init . tail . foldr (\el acc -> [] : map (el :) acc) [[]]
    suffixes = reverse . (fmap reverse) . prefixes . reverse

    check s = any (\(x, y) -> Set.member x allSet && Set.member y allSet) $ zip pref suf
      where
        pref = prefixes s
        suf = suffixes s

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

scan = numberOf $ TC <$> numberOf (C.unpack <$> str)

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import Data.Array ((!))
import Data.Array.ST (MArray (newArray), readArray, runSTArray, writeArray)
import qualified Data.ByteString.Char8 as C
import Data.Char (toLower)
import Data.List (nub, sort)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Debug.Trace (traceShowId, traceShow)

data TC = TC {ss :: [String]}

solve TC {..} = fmap (\case True -> '1'; _ -> '0') $ fmap check ss
  where
    allSet = traceShowId $ Set.fromList ss

    prefixes = init . tail . foldr (\el acc -> [] : map (el :) acc) [[]]
    suffixes = reverse . (fmap reverse) . prefixes . reverse

    check s = any (\(x, y) -> Set.member x allSet && Set.member y allSet) $ zip pref suf
      where
        pref = prefixes s
        suf = suffixes s

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

scan = numberOf $ TC <$> numberOf (C.unpack <$> str)

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

module Main (main) where
import Numeric (showFFloat)
import Data.Char (toUpper)
import Control.Monad
import Data.List (sortOn)
import qualified Data.Set as Set
import Data.Functor.Classes (eq2)
import qualified Data.Maybe as Maybe

-- reset && stack build && echo "success" && stack exec haskell-codeforces-exe && echo finished
--  gen-hie > hie.yaml

strToInt a = read a :: Int
strToFloat a = read a :: Float

pshow x = putStr (show x)
pfshow x = putStr (showFFloat (Just 2) x "")

-- hasStrSlice:: Set.Set String -> String -> Int -> Bool
hasStrSlice stringsSet str i = do
    (Maybe.isJust $ Set.lookupIndex (take (i + 1) str) stringsSet) && (
         Maybe.isJust $ Set.lookupIndex (drop (i + 1) str) stringsSet)

solveStr stringsSet str = do
    let res = any (hasStrSlice stringsSet str) [0..length str - 1]
    if res
        then "1"
        else "0"

solve = do
    n <- getLine

    strings <- replicateM (read n) getLine

    -- let stringsWithIndex = zip [0..] strings
    let stringsSet = Set.fromList strings

    putStrLn $ concatMap (solveStr stringsSet) strings

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

import Control.Monad (replicateM, replicateM_)
import Data.Function ((&))
import Data.Functor ((<&>))
import qualified Data.Set as Set

findStringsAnswers strings = map canComposeString strings
    where
        canComposeString s = partitions s & any (\ (a, b) -> hasString a && hasString b)
        partitions s = [splitAt i s | i <- [0 .. length s]]
        hasString s = Set.member s strings_set
        strings_set = Set.fromList strings

main = do
    [tests_n] <- readInts
    replicateM_ tests_n $ do
        [strings_n] <- readInts
        strings <- replicateM strings_n getLine
        let output = findStringsAnswers strings
                     & map (\ ans -> if ans then '1' else '0')
        putStrLn output

readInts = getLine <&> words <&> map read

import           Data.List
import qualified Data.Char as DC
import qualified Data.Set as Set
import Control.Monad (replicateM)

solveCase :: IO ()
solveCase = do
    n <- fmap (read :: String -> Int) getLine
    strs <- replicateM n getLine
    let setik = Set.fromList strs
    let res = map (\str -> (foldl (\cur el -> (cur || ((Set.member (take el str) setik) && (Set.member (drop el str) setik)))) False [1..(length str)-1])) strs
    putStrLn $ map (\x -> if x then '1' else '0') res

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)

-- road map in reverse, and the number of cities, init pen state
type Domain = [String]
type CoDomain = [Int]
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ intercalate " " $ map show xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- replicateM n getLine
  return xs

solve :: Solver
solve xs = [if r then 1 else 0 | r <- res ]
  where
   -- [map suffix n(the id of original string) indexed by prefix tree
   ys = Set.fromList xs
   f = (`elem` ys)
   res =  (\y -> any (\(a,b) -> f a && f b) $ (flip splitAt y) <$> [0..length y - 1]) <$> xs

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

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \r\n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []
readInt :: BS.ByteString -> Int
readInt line = let [x] = readInts line in x

solve :: [BS.ByteString] -> [Bool]
solve strs = map check strs
    where set :: S.Set BS.ByteString
          set = foldr S.insert S.empty strs
          check :: BS.ByteString -> Bool
          check str = or [check' i str | i <- [1 .. BS.length str - 1]]
          check' :: Int -> BS.ByteString -> Bool
          check' i str = S.member (BS.take i str) set && S.member (BS.drop i str) set

printSolution :: [Bool] -> IO ()
printSolution soln = putStrLn $ map (\x -> if x then '1' else '0') soln

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- readInt <$> BS.getLine
                    strs <- forM [1 .. n] (\x -> BS.getLine)
                    printSolution (solve strs)

main :: IO ()
main = do t <- readInt <$> BS.getLine
          forM_ [1 .. t] testCaseMain

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []
readInt :: BS.ByteString -> Int
readInt line = let [x] = readInts line in x

solve :: [BS.ByteString] -> [Bool]
solve strs = map check strs
    where set :: S.Set BS.ByteString
          set = foldr S.insert S.empty strs
          check :: BS.ByteString -> Bool
          check str = or [check' i str | i <- [1 .. BS.length str - 1]]
          check' :: Int -> BS.ByteString -> Bool
          check' i str = S.member (BS.take i str) set && S.member (BS.drop i str) set

printSolution :: [Bool] -> IO ()
printSolution soln = putStrLn $ map (\x -> if x then '1' else '0') soln

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- readInt <$> BS.getLine
                    strs <- forM [1 .. n] (\x -> BS.getLine)
                    printSolution (solve strs)

main :: IO ()
main = do t <- readInt <$> BS.getLine
          forM_ [1 .. t] testCaseMain

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

check :: String -> String -> Set.Set String -> Bool
check "" suff set = False
check pref suff set =
    if Set.member pref set && Set.member suff set
    then True
    else check (init pref) ((last pref) : suff) set

solve :: [String] -> [Bool]
solve strs =
    map (\x -> check x "" set) strs
    where set = Set.fromList strs

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    strs <- forM [1..n] (\x -> getLine)
    putStrLn $ filter (\x -> x /= ' ') $ unwords $ map (\x -> if x then "0" else "1") $ solve strs
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t


In the beginning of the new year Keivan decided to reverse his name. He doesn't like palindromes, so he changed Naviek to Navick.He is too selfish, so for a given n he wants to obtain a string of n characters, each of which is either 'a', 'b' or 'c', with no palindromes of length 3 appearing in the string as a substring. For example, the strings "abc" and "abca" suit him, while the string "aba" doesn't. He also want the number of letters 'c' in his string to be as little as possible.

The first line contains single integer n (1 ≤ n ≤ 2·105) — the length of the string.

Print the string that satisfies all the constraints. If there are multiple answers, print any of them.

NoteA palindrome is a sequence of characters which reads the same backward and forward.

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

module Main where
import qualified Data.ByteString.Char8 as B

main = do
  n <- fmap readInt B.getLine
  putStr $ solve n

solve n = take n $ cycle "aabb"

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

main :: IO ()
main = putStrLn . solve 0 . read =<< getLine

solve :: Int -> Int -> String
solve _ 0 = ""
solve i n | i `div` 2 `mod` 2 == 0 = 'a' : solve (i + 1) (n - 1)
          | otherwise = 'b' : solve (i + 1) (n - 1)

main :: IO ()
main = putStrLn . solve . read =<< getLine

solve :: Int -> String
solve 0 = ""
solve n | n `div` 2 `mod` 2 == 0 = 'a' : solve (n - 1)
        | otherwise = 'b' : solve (n - 1)

main = (readLn :: IO Int) >>= \x -> putStrLn $ take x $ cycle "aabb"

main = do
       e<-getLine
       let n=read e::Int
       putStrLn $ take n $ concat $ repeat "aabb"

main = interact $ solve . read
solve n = take n $ cycle "aabb"

main = readLn >>= putStrLn . solve ""

solve str n
  |n == 0 = str
  |otherwise = solve (("aabb" !! (n `mod` 4)):str) (n - 1)

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

readInt = maybe undefined fst . B.readInt

solve n = take n $ cycle "aabb"

main = solve . readInt <$> B.getLine >>= putStr

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

run xx 0 = xx
run [] 1 = "a"
run [] n = run "aa" (n - 2)
run xx@(x:y:xs) n | y == 'a' && x == 'a' = run ('b':xx) (n - 1)
                  | y == 'a' && x == 'b' = run ('b':xx) (n - 1)
                  | y == 'b' && x == 'b' = run ('a':xx) (n - 1)
                  | y == 'b' && x == 'a' = run ('a':xx) (n - 1)

main = do
    (readInt -> n) <- B.getLine
    putStrLn $ run [] n

main :: IO()
main = do
        inp <- getLine
        putStrLn $ output . solve . input $ inp

input :: String -> Int
input = read

solve :: Int -> String
solve n = ab "a" 0 n
    where
        ab _ _ 0 = ""
        ab "a" 0 n = "a" ++ ab "a" 1 (n-1)
        ab "a" 1 n = "a" ++ ab "b" 0 (n-1)
        ab "b" 0 n = "b" ++ ab "b" 1 (n-1)
        ab "b" 1 n = "b" ++ ab "a" 0 (n-1)

output :: String -> String
output = id

main = readLn >>= putStrLn . solve

solve n = take n (cycle "aabb")

main = (readLn :: IO Int) >>= \x -> putStrLn $ take x $ cycle "aabbc"


For each string s consisting of characters '0' and '1' one can define four integers a00, a01, a10 and a11, where axy is the number of subsequences of length 2 of the string s equal to the sequence {x, y}. In these problem you are given four integers a00, a01, a10, a11 and have to find any non-empty string s that matches them, or determine that there is no such string. One can prove that if at least one answer exists, there exists an answer of length no more than 1 000 000.

The only line of the input contains four non-negative integers a00, a01, a10 and a11. Each of them doesn't exceed 109.

If there exists a non-empty string that matches four integers from the input, print it in the only line of the output. Otherwise, print "Impossible". The length of your answer must not exceed 1 000 000.

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if all (/=(-1)) [a1,a2] && any (==0) [a1,a2] then do
                if (a1+a2 == b+c) then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '1')
                            _ -> putStrLn $ (replicate b '0') ++ "1" ++ (replicate c '0')
                else if (b+c) == 0 then do
                    putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else if all (==0) [a1,a2] && (b+c) == 1 then do
                    case b of
                        0 -> putStrLn "10"
                        1 -> putStrLn "01"
                else putStrLn "Impossible"
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Data.List
import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

change :: Int -> String -> Int -> Int -> String
change 0 str _ m = reverse (replicate m '0' ++ str)
change _ _   _ 0 = ""
change k str n m
  | k >= n    =
      let z = div k n
      in
        if z <= m
        then change (k - z*n) (str ++ replicate z '0') n (m - z)
        else ""
  | otherwise =
      let (strfst, strsnd) = splitAt k str
      in change 0 (strfst ++ '0' : strsnd) n (m - 1)

check :: String -> Int -> Int -> Bool
check []         _    0 = True
check ('0':rest) acum k = check rest (acum + 1) k
check ('1':rest) acum k = check rest acum (k - acum)
check _          _    _ = False

attempt :: Int -> Int -> Int -> Int -> Maybe String
attempt 0   0   1 m = Just $ replicate m '0'
attempt 0   0   n 1 = Just $ replicate n '1'
attempt a01 a10 n m =
  let att = change a01 (replicate n '1') n m
  in
    if null att || not (check (reverse att) 0 a10)
    then Nothing
    else Just att

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [1..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        case attempt a01 a10 n m of
          Nothing   -> "Impossible"
          Just soln -> soln

main :: IO ()
main = interact process

main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2])
                then putStrLn "Impossible"
                else if a1*a2 /= (b+c)
                    then putStrLn "Impossible"
                    else do
                        if (b+c) == 0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else if b==0 then putStrLn (replicate a2 '1' ++ replicate a1 '0')
                        else if c==0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else do
                            let zc = b `div` a2
                            putStrLn $ (replicate zc '0' ++ replicate a2 '1' ++ replicate (a1-zc) '0')

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if any (==0) [a1,a2] then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '0')
                            _ -> putStrLn $ (replicate c '0') ++ "1" ++ (replicate b '1')
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    let a1 = nc2 a
        a2 = nc2 d
    if any (==(-1)) [a1,a2]
        then putStrLn "Impossible"
        else if a1*a2 /= (b+c)
            then putStrLn "Impossible"
            else do
                if (b+c) == 0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else if b==0 then putStrLn (replicate a2 '1' ++ replicate a1 '0')
                else if c==0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else do
                    putStrLn $ '0':(replicate a2 '1' ++ replicate (a1-1) '0')

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if all (/=(-1)) [a1,a2] && any (==0) [a1,a2] then do
                if (a1+a2 == b+c) then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '1')
                            _ -> putStrLn $ (replicate b '0') ++ "1" ++ (replicate c '0')
                else putStrLn "Impossible"
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if all (/=(-1)) (map nc2 [a1,a2]) && any (==0) [a1,a2] && (nc2 (b+c) == (a1+a2)) then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '0')
                            _ -> putStrLn $ (replicate c '0') ++ "1" ++ (replicate b '1')
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else if any (==0) [a1,a2] then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '0')
                            _ -> putStrLn $ (replicate c '0') ++ "1" ++ (replicate b '1')
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if all (/=(-1)) [a1,a2] && any (==0) [a1,a2] then do
                if (a1+a2 == b+c) then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '1')
                            _ -> putStrLn $ (replicate b '0') ++ "1" ++ (replicate c '0')
                else if (b+c) ==0 then do
                    putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else putStrLn "Impossible"
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2])
                then putStrLn "Impossible"
                else if a1*a2 /= (b+c)
                    then putStrLn "Impossible"
                    else do
                        if (b+c) == 0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else if b==0 then putStrLn (replicate a2 '1' ++ replicate a1 '0')
                        else if c==0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else do
                            let zc = b `div` a2
                            putStrLn $ (replicate zc '0' ++ replicate a2 '1' ++ replicate (b-zc) '0')

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    print y
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    let a1 = nc2 a
        a2 = nc2 d
    if (any (==(-1)) [a1,a2]) || all (==0) [a,b,c,d]
        then putStrLn "Impossible"
        else if a1*a2 /= (b+c)
            then putStrLn "Impossible"
            else do
                if (b+c) == 0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else if b==0 then putStrLn (replicate a2 '1' ++ replicate a1 '0')
                else if c==0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                else do
                    putStrLn $ '0':(replicate a2 '1' ++ replicate (a1-1) '0')

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import Control.Monad
main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if all (/=(-1)) [a1,a2] && any (==0) [a1,a2] then do
                if (a1+a2 == b+c) then do
                        case a1 of
                            0 -> putStrLn $ (replicate c '1') ++ "0" ++ (replicate b '1')
                            _ -> putStrLn $ (replicate c '0') ++ "1" ++ (replicate b '0')
                else putStrLn "Impossible"
            else if (any (==(-1)) [a1,a2]) || a1*a2 /= (b+c)
                then putStrLn "Impossible"
                else do
                    let (_,_,y) = foldr fn (0,c,[]) [0..a2]
                        fn 0 (used,cnt,ls) = (-1,-1,(a1-used):ls)
                        fn x (used,cnt,ls) = (used + cnt `div` x,cnt `mod` x, (cnt `div` x:ls))
                    putStr (replicate (head y) '0')
                    forM_ (tail y) $ \n -> do
                        putChar '1'
                        mapM_ (\_ -> putChar '0') [1..n]

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

main = do
    [a,b,c,d] <- fmap ((map read) . words) getLine
    if all (==0) [a,b,c,d]
        then print 0
        else do
            let a1 = nc2 a
                a2 = nc2 d
            if (any (==(-1)) [a1,a2])
                then putStrLn "Impossible"
                else if a1*a2 /= (b+c)
                    then putStrLn "Impossible"
                    else do
                        if (b+c) == 0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else if b==0 then putStrLn (replicate a2 '1' ++ replicate a1 '0')
                        else if c==0 then putStrLn (replicate a1 '0' ++ replicate a2 '1')
                        else putStrLn $ '0':(replicate a2 '1' ++ replicate (a1-1) '0')

nc2 0 = 0
nc2 x =
    let a = ceiling . sqrt . fromIntegral $ (2*x)
    in if a*(a-1) == (2*x) then a else -1

import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [0..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        if (mod a01 n > 0) || (mod a10 n > 0)
        then "Impossible"
        else
          let x = div a01 n
              y = div a10 n
          in
            if comb (x + y) /= a00
            then "Impossible"
            else replicate x '0' ++ replicate n '1' ++ replicate y '0'

main :: IO ()
main = interact process

import Data.List
import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

change :: Int -> String -> Int -> Int -> String
change 0 str _ m = reverse (replicate m '0' ++ str)
change _ _   _ 0 = ""
change k str n m
  | k >= n    = change (k - n) (str ++ "0") n (m - 1)
  | otherwise =
      let (strfst, strsnd) = splitAt k str
      in change 0 (strfst ++ '0' : strsnd) n (m - 1)

check :: String -> Int -> Int -> Int -> Bool
check _ 0 _ 0 = True
check ('0':rest) n acum k = check rest n (acum + 1) k
check ('1':rest) n acum k = check rest (n - 1) acum (k - acum * n)
check _ _ _ _ = False

attempt :: Int -> Int -> Int -> Int -> Maybe String
attempt a01 a10 n m =
  let att = change a01 (replicate n '1') n m
  in
    if null att || check (reverse att) n 0 a10
    then Nothing
    else Just att

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [0..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        case attempt a01 a10 n m of
          Nothing   -> "Impossible"
          Just soln -> soln

main :: IO ()
main = interact process

import Data.List
import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

change :: Int -> String -> Int -> Int -> String
change 0 str _ m = reverse (replicate m '0' ++ str)
change _ _   _ 0 = ""
change k str n m
  | k >= n    = let z = div k n in change (k - z*n) (str ++ "0") n (m - z)
  | otherwise =
      let (strfst, strsnd) = splitAt k str
      in change 0 (strfst ++ '0' : strsnd) n (m - 1)

check :: String -> Int -> Int -> Bool
check []         _    0 = True
check ('0':rest) acum k = check rest (acum + 1) k
check ('1':rest) acum k = check rest acum (k - acum)
check _          _    _ = False

attempt :: Int -> Int -> Int -> Int -> Maybe String
attempt 0   0   1 m = Just $ replicate m '0'
attempt 0   0   n 1 = Just $ replicate n '1'
attempt a01 a10 n m =
  let att = change a01 (replicate n '1') n m
  in
    if null att || not (check (reverse att) 0 a10)
    then Nothing
    else Just att

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [1..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        case attempt a01 a10 n m of
          Nothing   -> "Impossible"
          Just soln -> soln

main :: IO ()
main = interact process

import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

attempt :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
attempt a01 a10 n m
  | (mod a01 n > 0) || (mod a10 n > 0) || comb (x + y) == m = Nothing
  | otherwise                                               = Just (x, y)
    where
      x = div a01 n
      y = div a10 n

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [0..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        case (attempt a01 a10 n m, attempt a01 a10 m n) of
          (Nothing,       Nothing)       -> "Impossible"
          (Just (xn, yn), Nothing)       -> replicate xn '0' ++ replicate n '1' ++ replicate yn '0'
          (Nothing,       Just (xm, ym)) -> replicate xm '1' ++ replicate m '0' ++ replicate ym '1'
          (Just (xn, yn), Just (xm, ym)) ->
            if xn + n + yn <= xm + m + ym
            then replicate xn '0' ++ replicate n '1' ++ replicate yn '0'
            else replicate xm '1' ++ replicate m '0' ++ replicate ym '1'

main :: IO ()
main = interact process

import Data.List
import qualified Data.Map.Strict as M

comb :: Int -> Int
comb n = div (n * (n - 1)) 2

change :: Int -> String -> Int -> Int -> String
change 0 str _ m = reverse (replicate (m+1) '0' ++ str)
change _ _   _ 0 = ""
change k str n m
  | k >= n    = if m >= n then change (k - n) (str ++ "0") n (m - n) else ""
  | otherwise =
      let (strfst, strsnd) = splitAt k str
      in if m >= k then change 0 (strfst ++ '0' : strsnd) n (m - k) else ""

check :: String -> Int -> Int -> Int -> Bool
check _ 0 _ 0 = True
check ('0':rest) n acum k = check rest n (acum + 1) k
check ('1':rest) n acum k = check rest (n - 1) acum (k - acum * n)
check _ _ _ _ = False

attempt :: Int -> Int -> Int -> Int -> Char -> Char -> Maybe String
attempt a01 a10 n m chrn chrm =
  let att = change a01 (replicate n chrn) n m
  in
    if null att || check (reverse att) n 0 a10
    then Nothing
    else Just att

process :: String -> String
process str =
  let [a00, a01, a10, a11] = map read . words $ str
      combMap              = M.fromList [(comb n, n) | n <- [0..10^5]]
  in
    case (M.lookup a11 combMap, M.lookup a00 combMap) of
      (Nothing, _)       -> "Impossible"
      (_,       Nothing) -> "Impossible"
      (Just n,  Just m)  ->
        case (attempt a01 a10 n m '1' '0', attempt a01 a10 m n '0' '1') of
          (Nothing,   Nothing)   -> "Impossible"
          (Just soln, Nothing)   -> soln
          (Nothing,   Just solm) -> solm
          (Just soln, Just solm) ->
            if length soln <= length solm
            then soln
            else solm

main :: IO ()
main = interact process


Two pirates Polycarpus and Vasily play a very interesting game. They have n chests with coins, the chests are numbered with integers from 1 to n. Chest number i has ai coins. Polycarpus and Vasily move in turns. Polycarpus moves first. During a move a player is allowed to choose a positive integer x (2·x + 1 ≤ n) and take a coin from each chest with numbers x, 2·x, 2·x + 1. It may turn out that some chest has no coins, in this case the player doesn't take a coin from this chest. The game finishes when all chests get emptied.Polycarpus isn't a greedy scrooge. Polycarpys is a lazy slob. So he wonders in what minimum number of moves the game can finish. Help Polycarpus, determine the minimum number of moves in which the game can finish. Note that Polycarpus counts not only his moves, he also counts Vasily's moves.

The first line contains a single integer n (1 ≤ n ≤ 100) — the number of chests with coins. The second line contains a sequence of space-separated integers: a1, a2, ..., an (1 ≤ ai ≤ 1000), where ai is the number of coins in the chest number i at the beginning of the game.

Print a single integer — the minimum number of moves needed to finish the game. If no sequence of turns leads to finishing the game, print -1.

NoteIn the first test case there isn't a single move that can be made. That's why the players won't be able to empty the chests.In the second sample there is only one possible move x = 1. This move should be repeated at least 3 times to empty the third chest.

import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed

main = do
  n <- fmap read getLine
  x <- fmap (map read . words) getLine
  y <- newArray_ (1, n) :: IO (IOUArray Int Int)
  z <- newArray (1, n) 0 :: IO (IOUArray Int Int)
  forM_ (zip [1 .. n] x) $ \(i, e) ->
    writeArray y i e
  forM_ (reverse [1 .. n]) $ \i -> do
    l <- index y $ i * 2
    r <- index y $ i * 2 + 1
    m <- index y i
    writeArray z i $ max l r
    writeArray y i $ max 0 $ m - max l r
  h <- index y 1
  t <- getElems z

  if n >= 3 && odd n
    then print $ sum $ h:t
    else print $ -1
  where
    index :: IOUArray Int Int -> Int -> IO Int
    index a i = do
      bounds <- getBounds a
      if inRange bounds i
        then readArray a i
        else return 0