{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

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

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

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

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

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

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

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

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

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

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

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

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

itof :: Int -> Double
itof = fromIntegral

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

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

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

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

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

doit :: Int -> [Int] -> Maybe [Int]
doit k l | null cs || (foldl' (.&.) (2^k-1) cs) /= 0 = Nothing
         | otherwise = Just cs
    where cs = filter (flip testBit k) l

main = do
    n <- readInt <$> B.getLine
    l <- map readInt . B.words <$> B.getLine
    let bs = last $ catMaybes $ [doit k l | k <- [0..30]]
    print (length bs)
    putStrLn $ unwords $ map show bs

import Data.Bits
maxV = 30
verify :: Int -> [Int] -> Bool
verify v xs = 0 == mod (foldr (.&.) (2^v - 1) xs) (2^v)
subsetAt :: Int -> [Int] -> [Int]
subsetAt v xs = filter (`testBit` v) xs
solve xs = (show (length sols)) ++ "\n" ++ unwords (map show sols)
    where sols = head [s | v <- [maxV, maxV-1..0], let s = subsetAt v xs, verify v s]
main = putStrLn.solve.map read.tail.words =<< getContents

import Data.Bits

lowbit :: Int -> Int
lowbit x = x .&. (-x)

getVal :: [Int] -> Int
getVal [] = -1
getVal xs = if andAll /= 0 then lowbit andAll else -1
	where
		andAll = foldl1 (.&.) xs

getBest :: [Int] -> [Int] -> [Int]
getBest xs ys
	| valX /= valY = if valX > valY then xs else ys
	| otherwise    = if length xs > length ys then xs else ys
	where
		valX = getVal xs
		valY = getVal ys

calc :: [Int] -> [Int]
calc xs = foldl1 getBest (xs : [filter (\x -> testBit x b) xs | b <- [0 .. 30]])

handle :: [String] -> [[String]]
handle (_ : sa) = [[show $ length res], map show res]
	where
		res = calc $ map read sa

main :: IO ()
main = interact $ unlines . map unwords . handle . words

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM)
import Data.Bits ((.&.))
import Data.Int (Int64)
import Data.List (foldl', group, sort)
import qualified Data.ByteString.Lazy.Char8 as BS

toInt64 :: Int -> Int64
toInt64 = fromIntegral

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

forMask :: [Int64] -> Int64 -> [Int64]
forMask xs mask = filter ((== mask) . (.&. mask)) xs

check :: [Int64] -> Int -> Bool
check xs v = acc .&. (mask - 1) == 0
  where mask = 2 ^ v :: Int64
        acc  = foldl' (.&.) (-1 :: Int64) $ forMask xs mask

solve :: [Int] -> [Int]
solve xs = if null vs
           then xs
           else map fromIntegral $ forMask bs (2 ^ (head vs))
  where bs = map toInt64 xs
        vs = filter (check bs) [32, 31 .. 0]

main = do
  (n:xs) <- liftM (map readInt . BS.words) BS.getContents
  let result = map head . group . sort $ solve xs
  print $ length result
  putStrLn . unwords $ map show result

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM)
import Data.Bits ((.&.))
import Data.Int (Int64)
import Data.List (foldl', group, sort)
import qualified Data.ByteString.Lazy.Char8 as BS

toInt64 :: Int -> Int64
toInt64 = fromIntegral

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

check :: Int -> [Int64] -> Bool
check v xs = acc .&. (limit - 1) == 0
  where limit = 2 ^ v :: Int64
        acc   = foldl' (.&.) (-1 :: Int64) $ filter (>= limit) xs

solve :: [Int] -> [Int]
solve xs = filter (>= (2 ^ v)) xs
  where bs = map toInt64 xs
        v  = go 0 32

        go lo hi | lo + 1 == hi = lo
                 | check mi bs  = go mi hi
                 | otherwise    = go lo mi
          where mi = (lo + hi) `div` 2

main = do
  (n:xs) <- liftM (map readInt . BS.words) BS.getContents
  let result = map head . group . sort $ solve xs
  print $ length result
  putStrLn . unwords $ map show result

import Data.Bits

lowbit :: Int -> Int
lowbit x = x .&. (-x)

getBest :: [Int] -> [Int] -> [Int]
getBest [] [] = []
getBest [] ys = ys
getBest xs [] = xs
getBest xs ys
	| valX /= valY = if valX > valY then xs else ys
	| otherwise    = if length xs > length ys then xs else ys
	where
		valX = lowbit $ foldl1 (.&.) xs
		valY = lowbit $ foldl1 (.&.) ys

calc :: [Int] -> [Int]
calc xs = if res /= [] then res else xs
	where
		res = foldl1 getBest [filter (\x -> (x .&. (shift b 1)) /= 0) xs | b <- [0 .. 30]]

handle :: [String] -> [[String]]
handle (_ : sa) = [[show $ length res], map show res]
	where
		res = calc $ map read sa

main :: IO ()
main = interact $ unlines . map unwords . handle . words

import Data.Bits

lowbit :: Int -> Int
lowbit x = x .&. (-x)

getBest :: [Int] -> [Int] -> [Int]
getBest [] [] = []
getBest [] ys = ys
getBest xs [] = xs
getBest xs ys
	| valX > valY = xs
	| valX < valY = ys
	| otherwise   = if length xs > length ys then xs else ys
	where
		valX = lowbit $ foldl1 (.&.) xs
		valY = lowbit $ foldl1 (.&.) ys

calc :: [Int] -> [Int]
calc xs = foldl1 getBest [filter (\x -> (x .&. (shift b 1)) /= 0) xs | b <- [0 .. 30]]

handle :: [String] -> [[String]]
handle (_ : sa) = [[show $ length res], map show res]
	where
		res = calc $ map read sa

main :: IO ()
main = interact $ unlines . map unwords . handle . words

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM)
import Data.Bits ((.&.))
import Data.Int (Int64)
import Data.List (foldl', group, sort)
import qualified Data.ByteString.Lazy.Char8 as BS

toInt64 :: Int -> Int64
toInt64 = fromIntegral

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

check :: Int -> [Int64] -> Bool
check v xs = acc .&. (limit - 1) == 0
  where limit = 2 ^ v
        acc   = foldl' (.&.) (-1) $ filter (>= limit) xs

solve :: [Int] -> [Int]
solve xs = filter (>= (2 ^ v)) xs
  where bs = map toInt64 xs
        v  = go 0 32

        go lo hi | lo + 1 == hi = lo
                 | check mi bs  = go mi hi
                 | otherwise    = go lo mi
          where mi = (lo + hi) `div` 2

main = do
  (n:xs) <- liftM (map readInt . BS.words) BS.getContents
  let result = map head . group . sort $ solve xs
  print $ length result
  putStrLn . unwords $ map show result

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM)
import Data.Bits ((.&.))
import Data.Int (Int64)
import Data.List (foldl', sort)
import qualified Data.ByteString.Lazy.Char8 as BS

toInt64 :: Int -> Int64
toInt64 = fromIntegral

readInt :: BS.ByteString -> Int
readInt s = case BS.readInt s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Int"

check :: Int -> [Int64] -> Bool
check v xs = acc .&. (limit - 1) == 0
  where limit = 2 ^ v
        acc   = foldl' (.&.) (-1) $ filter (>= limit) xs

solve :: [Int] -> [Int]
solve xs = filter (>= (2 ^ v)) xs
  where bs = map toInt64 xs
        v  = go 0 32

        go lo hi | lo + 1 == hi = lo
                 | check mi bs  = go mi hi
                 | otherwise    = go lo mi
          where mi = (lo + hi) `div` 2

main = do
  (n:xs) <- liftM (map readInt . BS.words) BS.getContents
  let result = solve xs
  print $ length result
  putStrLn . unwords $ map show result


import Data.List

suffixAfterSubstring :: String -> String -> Maybe String
suffixAfterSubstring string substring = let
    ends = filter (isPrefixOf substring) (tails string)
    in stripPrefix substring (head ends)

canSeeSequences :: String -> String -> String -> Bool
canSeeSequences actual s1 s2
    | not (s1 `isInfixOf` actual) = False
    | otherwise = case (suffixAfterSubstring actual s1) of
        Nothing -> False
        Just rest -> s2 `isInfixOf` rest

solve :: (String, String, String) -> String
solve (actual, s1, s2)
    | canSeeForward && canSeeBackward = "both"
    | canSeeForward = "forward"
    | canSeeBackward = "backward"
    | otherwise = "fantasy"
        where
            canSeeForward = canSeeSequences actual s1 s2
            canSeeBackward = canSeeSequences (reverse actual) s1 s2

parse :: [String] -> (String, String, String)
parse ls = (head ls, head $ tail ls, last ls)

main = interact $ solve . parse . lines

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

search :: String -> String -> Maybe String
search = do
  sign <- id
  return $ do
    ss <- iterate (drop 1)
    return $ do
      s <- find (and . zipWith (==) sign) ss
      let (as, bs) = splitAt (length sign) s
      guard $ as == sign
      return bs

solve :: [String] -> [String]
solve = fmap return $ do
  [s, sign1, sign2] <- take 3
  let check n x = maybe 0 (const n)
                $ return x >>= search sign1 >>= search sign2
  let idx = check 1 s + check 3 (reverse s)
  return $ ["fantasy", "forward", undefined, "backward", "both"] !! idx

main = interact $ unlines . solve . lines

module Main where

import Control.Applicative (liftA3)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = liftA3 solve bsGetLine bsGetLine bsGetLine >>= putStrLn

-- https://github.com/haskell/bytestring/issues/13
bsGetLine :: IO BS.ByteString
bsGetLine = BS.pack <$> getLine

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
solve flags a b= case (follows flags, follows (BS.reverse flags)) of
  (True, True) -> "both"
  (True, _) -> "forward"
  (_, True) -> "backward"
  _ -> "fantasy"
  where
    follows f = case BS.breakSubstring a f of
      (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest
solve flags a b = show $ BS.length a

l=length
s f a b|take(l a)b==a=f$drop(l a)b|null b=0|1>0=s f a(tail b)
c a b l=s(s(const 1)b)a l
z[x,a,b]=["fantasy","backward","forward","both"]!!(c a b x*2+c a b(reverse x))
main=interact$z.lines

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import System.IO (hSetNewlineMode, universalNewlineMode, stdin)

(-->) = flip fmap

-- does s contain a followed by b
follows :: ByteString -> ByteString -> ByteString -> Bool
follows s a b =
  case BS.breakSubstring a s of
    (x,y) | BS.null y -> False
          | otherwise -> BS.isInfixOf b (BS.drop (BS.length a) y)

main = do
  hSetNewlineMode stdin universalNewlineMode
  s <- getLine --> BS.pack
  a <- getLine --> BS.pack
  b <- getLine --> BS.pack
  let forward = follows s a b
      backward = follows (BS.reverse s) a b
      answer = case (forward,backward) of
                 (True,True) -> "both"
                 (True,_)    -> "forward"
                 (_,True)    -> "backward"
                 otherwise   -> "fantasy"
  putStrLn answer

import Data.List
import Data.Maybe

findSub :: (Eq a) => [a] -> [a] -> [(Int, Int)]
findSub xs ys = findSub' 0 xs ys
  where
    findSub' n xs [] = []
    findSub' n xs ys
        | xs `isPrefixOf` ys
            = (n, n + length xs - 1) : findSub' (n + 1) xs (tail ys)
        | otherwise = findSub' (n + 1) xs $ tail ys

findHead, findLast :: (Eq a) => [a] -> [a] -> Maybe Int
findHead x xs
    | null result = Nothing
    | otherwise = Just $ snd $ minimum result
  where result = findSub x xs

findLast x xs
    | null result = Nothing
    | otherwise = Just $ fst $ maximum result
  where result = findSub x xs

patternExists :: (Eq a) => [a] -> [a] -> [a] -> Bool
patternExists a b xs = fromMaybe False $ do
    ai <- findHead a xs
    bi <- findLast b xs
    return $ ai < bi

main = do
    train <- getLine
    a <- getLine
    b <- getLine
    case (patternExists a b train, patternExists a b $ reverse train) of
        (True, True) -> putStrLn "both"
        (True, False) -> putStrLn "forward"
        (False, True) -> putStrLn "backward"
        (False, False) -> putStrLn "fantasy"

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

search :: String -> String -> Maybe String
search = do
  sign <- id
  return $ do
    ss <- iterate (drop 1)
    return $ do
      s <- find (and . zipWith (==) sign) ss
      let (as, bs) = splitAt (length sign) s
      guard $ as == sign
      return bs

solve :: [String] -> [String]
solve = fmap return $ do
  [s, sign1, sign2] <- take 3
  let check n x = maybe 0 (const n)
                $ return x >>= search sign1 >>= search sign2
  let idx = check 1 s + check 3 (reverse s)
  return $ ["fantasy", "forward", undefined, "backword", "both"] !! idx

main = interact $ unlines . solve . lines

module Main where

import Control.Applicative (liftA3)
import System.IO (hSetNewlineMode, universalNewlineMode, stdin)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  hSetNewlineMode stdin universalNewlineMode
  result <- liftA3 solve BS.getLine BS.getLine BS.getLine
  putStrLn result

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
-- solve flags a b= case (follows flags, follows (BS.reverse flags)) of
--   (True, True) -> "both"
--   (True, _) -> "forward"
--   (_, True) -> "backward"
--   _ -> "fantasy"
--   where
--     follows f = case BS.breakSubstring a f of
--       (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest
solve flags a b = show $ BS.length a

module Main where

import qualified Data.ByteString.Char8 as BS
import Control.Applicative (liftA3)

main :: IO ()
main = liftA3 solve BS.getLine BS.getLine BS.getLine >>= putStrLn

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
solve flags a b = case (follows flags, follows (BS.reverse flags)) of
    (True, True) -> "both"
    (True, _) -> "forward"
    (_, True) -> "backward"
    _ -> "fantasy"
  where
    follows f = case BS.breakSubstring a f of
      (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest

module Main where

import System.IO
import Control.Applicative (liftA3)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main =   hSetNewlineMode stdin universalNewlineMode >> liftA3 solve BS.getLine BS.getLine BS.getLine >>= putStrLn

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
solve flags a b= case (follows flags, follows (BS.reverse flags)) of
  (True, True) -> "both"
  (True, _) -> "forward"
  (_, True) -> "backward"
  _ -> "fantasy"
  where
    follows f = case BS.breakSubstring a f of
      (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest

module Main where

import Control.Applicative (liftA3)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = liftA3 solve BS.getLine BS.getLine BS.getLine >>= putStrLn

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
-- solve flags a b= case (follows flags, follows (BS.reverse flags)) of
--   (True, True) -> "both"
--   (True, _) -> "forward"
--   (_, True) -> "backward"
--   _ -> "fantasy"
--   where
--     follows f = case BS.breakSubstring a f of
--       (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest
solve flags a b = show $ BS.length a

module Main where

import Control.Applicative (liftA3)
import System.IO (hSetNewlineMode, universalNewlineMode, stdin)

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = liftA3 solve bsGetLine bsGetLine bsGetLine >>= putStrLn

bsGetLine :: IO BS.ByteString
bsGetLine = BS.pack <$> getLine

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
-- solve flags a b= case (follows flags, follows (BS.reverse flags)) of
--   (True, True) -> "both"
--   (True, _) -> "forward"
--   (_, True) -> "backward"
--   _ -> "fantasy"
--   where
--     follows f = case BS.breakSubstring a f of
--       (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest
solve flags a b = show $ BS.length a

module Main where

import Control.Applicative (liftA3)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = solve . BS.lines <$> BS.getContents >>= putStrLn

solve :: [BS.ByteString] -> String
-- solve [flags, a, b] = case (follows flags, follows (BS.reverse flags)) of
--   (True, True) -> "both"
--   (True, _) -> "forward"
--   (_, True) -> "backward"
--   _ -> "fantasy"
--   where
--     follows f = case BS.breakSubstring a f of
--       (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest
solve [flags, a, b] = BS.unpack flags

module Main where

import Control.Applicative (liftA3)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = solve . BS.lines <$> BS.getContents >>= putStrLn

solve :: [BS.ByteString] -> String
solve [flags, a, b] = case (follows flags, follows (BS.reverse flags)) of
  (True, True) -> "both"
  (True, _) -> "forward"
  (_, True) -> "backward"
  _ -> "fantasy"
  where
    follows f = case BS.breakSubstring a f of
      (_, rest) -> (not . BS.null) rest && b `BS.isInfixOf` BS.drop (BS.length a) rest

s(a:x)b|h==a=s x t|[]==b=0|1>0=s(a:x)t where(h,t)=splitAt(length a)b
s _ _=1
z(x:t)=["fantasy","backward","forward","both"]!!(s t x*2+s t(reverse x))
main=interact$z.lines

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import GHC.IO.Handle (hSetNewlineMode, NewlineMode(..), Newline(..))
import System.IO (stdin)

-- does s contain a followed by b
follows :: ByteString -> ByteString -> ByteString -> Bool
follows s a b =
  case BS.breakSubstring a s of
    (x,y) | BS.null y -> False
          | otherwise -> BS.isInfixOf b y

main = do
  hSetNewlineMode stdin (NewlineMode CRLF LF)
  s <- BS.getLine
  a <- BS.getLine
  b <- BS.getLine
  let forward = follows s a b
      backward = follows (BS.reverse s) a b
      answer = case (forward,backward) of
                 (True,True) -> "both"
                 (True,_)    -> "forward"
                 (_,True)    -> "backward"
                 otherwise   -> "fantasy"
  putStrLn answer

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

-- does s contain a followed by b
follows :: ByteString -> ByteString -> ByteString -> Bool
follows s a b =
  case BS.breakSubstring a s of
    (x,y) | BS.null y -> False
          | otherwise -> BS.isInfixOf b y

main = do
  s <- BS.getLine
  a <- BS.getLine
  b <- BS.getLine
  let forward = follows s a b
      backward = follows (BS.reverse s) a b
      answer = case (forward,backward) of
                 (True,True) -> "both"
                 (True,_)    -> "forward"
                 (_,True)    -> "backward"
                 otherwise   -> "fantasy"
  putStrLn answer

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

-- does s contain a followed by b
follows :: ByteString -> ByteString -> ByteString -> Bool
follows s a b =
  case BS.breakSubstring a s of
    (x,y) | BS.null y -> False
          | otherwise -> BS.isInfixOf b y

main = do
  s <- BS.getLine
  a <- BS.getLine
  b <- BS.getLine
  let forward = follows s a b
      backward = follows (BS.reverse s) a b
      answer = case (forward,backward) of
                 (True,True) -> "both"
                 (True,_)    -> "forward"
                 (_,True)    -> "backward"
                 otherwise   -> "fantasy"
  putStrLn $ "s: " ++ show s
  putStrLn $ "a: " ++ show a
  putStrLn $ "b: " ++ show b
  putStrLn answer

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import GHC.IO.Handle (hSetNewlineMode, NewlineMode(..), Newline(..))
import System.IO (stdin)

(-->) = flip fmap

-- does s contain a followed by b
follows :: ByteString -> ByteString -> ByteString -> Bool
follows s a b =
  case BS.breakSubstring a s of
    (x,y) | BS.null y -> False
          | otherwise -> BS.isInfixOf b y

main = do
  hSetNewlineMode stdin (NewlineMode CRLF CRLF)
  s <- getLine --> BS.pack
  a <- getLine --> BS.pack
  b <- getLine --> BS.pack
  let forward = follows s a b
      backward = follows (BS.reverse s) a b
      answer = case (forward,backward) of
                 (True,True) -> "both"
                 (True,_)    -> "forward"
                 (_,True)    -> "backward"
                 otherwise   -> "fantasy"
  putStrLn answer

import Data.List
import Data.Maybe

findSub :: (Eq a) => [a] -> [a] -> [Int]
findSub xs ys = findSub' 0 xs ys
  where
    findSub' n xs [] = []
    findSub' n xs ys
        | xs `isPrefixOf` ys = n : findSub' (n + 1) xs (tail ys)
        | otherwise = findSub' (n + 1) xs $ tail ys

findHead x xs
    | null result = Nothing
    | otherwise = Just $ minimum result
  where result = findSub x xs

findLast x xs
    | null result = Nothing
    | otherwise = Just $ maximum result
  where result = findSub x xs

patternExists a b xs = fromMaybe False $ do
    ai <- findHead a xs
    bi <- findLast b xs
    return $ ai < bi

main = do
    train <- getLine
    a <- getLine
    b <- getLine
    case (patternExists a b train, patternExists b a train) of
        (True, True) -> putStrLn "both"
        (True, False) -> putStrLn "forward"
        (False, True) -> putStrLn "backward"
        (False, False) -> putStrLn "fantasy"

import Data.List
import Data.Maybe

findSub :: (Eq a) => [a] -> [a] -> [Int]
findSub xs ys = findSub' 0 xs ys
  where
    findSub' n xs [] = []
    findSub' n xs ys
        | xs `isPrefixOf` ys = n : findSub' (n + 1) xs (tail ys)
        | otherwise = findSub' (n + 1) xs $ tail ys

findHead x xs
    | null result = Nothing
    | otherwise = Just $ minimum result
  where result = findSub x xs

findLast x xs
    | null result = Nothing
    | otherwise = Just $ maximum result
  where result = findSub x xs

patternExists a b xs = fromMaybe False $ do
    ai <- findHead a xs
    bi <- findLast b xs
    return $ ai < bi

main = do
    train <- getLine
    a <- getLine
    b <- getLine
    case (patternExists a b train, patternExists a b $ reverse train) of
        (True, True) -> putStrLn "both"
        (True, False) -> putStrLn "forward"
        (False, True) -> putStrLn "backward"
        (False, False) -> putStrLn "fantasy"

import Data.List

findSub :: (Eq a) => [a] -> [a] -> [Int]
findSub xs ys = findSub' 0 xs ys
  where
    findSub' n xs [] = []
    findSub' n xs ys
        | xs `isPrefixOf` ys = n : findSub' (n + 1) xs (tail ys)
        | otherwise = findSub' (n + 1) xs $ tail ys

main = do
    train <- getLine
    a <- getLine
    b <- getLine
    let ais = findSub a train
        bis = findSub b train
    case null ais || null bis of
        True -> putStrLn "fantasy"
        _ -> case (maximum ais > minimum bis, minimum ais < maximum bis) of
            (False, True) -> putStrLn "forward"
            (True, False) -> putStrLn "backward"
            _ -> putStrLn "both"


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 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

{-# 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 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


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


{-# 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 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

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.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)

{-# 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

{-# 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


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

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
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


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)

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

{-# 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 ()

{-# 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


main = readLn >>= putStrLn . solve

solve n = take n (cycle "aabb")

{-# 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 :: IO Int) >>= \x -> putStrLn $ take x $ cycle "aabbc"


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

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

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