For an array of non-negative integers $$$a$$$ of size $$$n$$$, we construct another array $$$d$$$ as follows: $$$d_1 = a_1$$$, $$$d_i = |a_i - a_{i - 1}|$$$ for $$$2 \le i \le n$$$.Your task is to restore the array $$$a$$$ from a given array $$$d$$$, or to report that there are multiple possible arrays.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the size of the arrays $$$a$$$ and $$$d$$$. The second line contains $$$n$$$ integers $$$d_1, d_2, \dots, d_n$$$ ($$$0 \le d_i \le 100$$$) — the elements of the array $$$d$$$. It can be shown that there always exists at least one suitable array $$$a$$$ under these constraints.

For each test case, print the elements of the array $$$a$$$, if there is only one possible array $$$a$$$. Otherwise, print $$$-1$$$.

NoteIn the second example, there are two suitable arrays: $$$[2, 8, 5]$$$ and $$$[2, 8, 11]$$$.

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>=
        \n -> map read . words <$> getLine >>=
        \ds -> case findA n ds of
                 Just as -> mapM_ (\a -> putStr (show a ++ " ")) as >>
                            putStrLn ""
                 Nothing -> putStrLn "-1"

maxA (d:ds) = scanl (+) d ds

findA :: Int -> [Int] -> Maybe [Int]
findA n ds = let mA = maxA ds in
               if any (\(a, d) -> d <= a && d > 0) (zip mA (tail ds))
               then Nothing
               else Just mA

{-# LANGUAGE ScopedTypeVariables #-}

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

import Control.Monad
import Control.Monad.Trans.State
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import qualified Data.ByteString.Lazy.Char8 as P
import Data.Maybe
import Debug.Trace
import System.IO (BufferMode (NoBuffering), hSetBuffering, stdout)

mainFun :: SP Builder
mainFun = do
  casnum <- getInt
  ress <- forM [1 .. casnum] $ \_ -> do
    n <- getInt
    d <- replicateM n getInt
    let a = scanl1 (+) d
    let only = all (\(x, y) -> x < y || y == 0) $ zip a (tail d)
    let res = if only then a else [-1]
    pure res
  pure $ foldl1 (<>) $ map putInts ress

type SP = State P.ByteString

type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n] <- ri
        ds   <- ri
        return ds
    mapM_ (putStrLn.showAns.solve) tcs

showAns = maybe "-1" (unwords . map show)

solve (d:ds) = ans
  where
    tt = L.scanl' g (Just d) $ ds
    ans | all isJust tt  = Just (map fromJust tt)
        | otherwise      = Nothing

    g Nothing  _ = Nothing
    g (Just a) b = f a b

    f prevA currD | length cands == 1  = Just (head cands)
                  | otherwise          = Nothing
      where
        cands = L.nub . filter (>=0) $ [prevA + currD, prevA - currD]
solve _ = error "Empty input?"

{-# LANGUAGE CPP #-}
{-# 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.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

type TC = [Int]

type Output = Maybe [Int]

input :: Scanner TC
input = numberOf int

solve :: TC -> Output
solve ds = guard (zip as (tail ds) >$> filter (snd >>> (/= 0)) >>> all (uncurry (<))) >> return as
  where
    as = scanl1 (+) ds

output :: Int -> Output -> C.ByteString
output _ = fmap (map show >>> unwords) >>> fromMaybe "-1" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

-- 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 Control.Monad

toShow [] = ""
toShow (x:xs) = show x ++ " " ++ toShow xs

main :: IO ()
main = do
    ts <- getLine
    replicateM (read ts::Int) $ do
        input <- getLine
        let n = read  input ::Int
        input <- getLine
        let d = map read . words $ input ::[Int]
        let a = scanl1 (+) d
        putStrLn $ if any (\(x,y) -> x>=y && y/=0) $ zip a (tail d) then "-1" else toShow a
    return ()


After several latest reforms many tourists are planning to visit Berland, and Berland people understood that it's an opportunity to earn money and changed their jobs to attract tourists. Petya, for example, left the IT corporation he had been working for and started to sell souvenirs at the market.This morning, as usual, Petya will come to the market. Petya has n different souvenirs to sell; ith souvenir is characterised by its weight wi and cost ci. Petya knows that he might not be able to carry all the souvenirs to the market. So Petya wants to choose a subset of souvenirs such that its total weight is not greater than m, and total cost is maximum possible.Help Petya to determine maximum possible total cost.

The first line contains two integers n and m (1 ≤ n ≤ 100000, 1 ≤ m ≤ 300000) — the number of Petya's souvenirs and total weight that he can carry to the market. Then n lines follow. ith line contains two integers wi and ci (1 ≤ wi ≤ 3, 1 ≤ ci ≤ 109) — the weight and the cost of ith souvenir.

Print one number — maximum possible total cost of souvenirs that Petya can carry to the market.

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

getInts :: IO [Int]
getInts = map (fst . fromJust . B.readInt) <$> B.words <$> B.getContents
getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . B.readInteger) <$> B.words <$> B.getContents
pair []       = []
pair (x:y:rs) = (x, y) : pair rs
clamp u v w = max u $ min v $ w

main = do
    (_:m:xs) <- getInts
    print $ solve m (pair $ map toInteger xs)

solve :: Int -> [(Integer, Integer)] -> Integer
solve m ps = go a3 0 m r0 r1
  where
    a1 = reverse . sort $ map snd $ filter ((==1) . fst) ps
    a2 = reverse . sort $ map snd $ filter ((==2) . fst) ps
    a3 = reverse . sort $ map snd $ filter ((==3) . fst) ps
    (r0, r1) = prepare a1 a2

removeOutdated [] m     = [(0, 0)]
removeOutdated (r:rs) m = if fst r <= m then (r:rs) else removeOutdated rs m

go :: [Integer] -> Integer -> Int -> [(Int, Integer)] -> [(Int, Integer)] -> Integer
go a3 s3 m r0 r1 = max current next
  where
    r0' = removeOutdated r0 m
    r1' = removeOutdated r1 m
    current = s3 + (snd . head $ if mod m 2 == 0 then r0' else r1')
    next = if m >= 3 && not (null a3)
            then go (tail a3) (s3 + head a3) (m-3) r0' r1'
            else 0

prepare :: [Integer] -> [Integer] -> ([(Int, Integer)], [(Int, Integer)])
prepare a1 a2 = (reverse $ zip [2,4..] v0', reverse $ zip [1,3..] v1')
  where
    (a10, a11) = evenOddSplit $ a1 ++ [0, 0]
    v0 = a2 ++ zipWith (+) a10 a11
    v1 = a2 ++ zipWith (+) (tail a10) a11
    v0' = scanl1 (+) $ reverse $ sort v0
    v1' = map (+ head a10) $ scanl (+) 0 $ reverse $ sort v1

evenOddSplit []     = ([], [])
evenOddSplit (x:xs) = let (e, o) = evenOddSplit xs in (x:o, e)


One day Bob got a letter in an envelope. Bob knows that when Berland's post officers send a letter directly from city «A» to city «B», they stamp it with «A B», or «B A». Unfortunately, often it is impossible to send a letter directly from the city of the sender to the city of the receiver, that's why the letter is sent via some intermediate cities. Post officers never send a letter in such a way that the route of this letter contains some city more than once. Bob is sure that the post officers stamp the letters accurately.There are n stamps on the envelope of Bob's letter. He understands that the possible routes of this letter are only two. But the stamps are numerous, and Bob can't determine himself none of these routes. That's why he asks you to help him. Find one of the possible routes of the letter.

The first line contains integer n (1 ≤ n ≤ 105) — amount of mail stamps on the envelope. Then there follow n lines with two integers each — description of the stamps. Each stamp is described with indexes of the cities between which a letter is sent. The indexes of cities are integers from 1 to 109. Indexes of all the cities are different. Every time the letter is sent from one city to another, exactly one stamp is put on the envelope. It is guaranteed that the given stamps correspond to some valid route from some city to some other city.

Output n + 1 numbers — indexes of cities in one of the two possible routes of the letter.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  let readInts = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readInts
  let check acc _ = do
        x : y : _ <- readInts
        let acc'  = Map.insertWith (Set.union) y (Set.singleton x) acc
            acc'' = Map.insertWith (Set.union) x (Set.singleton y) acc'
        return acc''
  pathes <- foldM check Map.empty [1 .. n]
  let Just (start, _) = find ((== 1) . Set.size . snd)
        $ Map.toList pathes
      search (mp, i)
        | i < 0       = Nothing
        | Map.null mp = Just (show i, (mp, -1))
        | otherwise   = do
            let s     = mp Map.! i
                j : _ = Set.toList s
                s'    = mp Map.! j
                t     = Set.delete j s
                t'    = Set.delete i s'
                mp'  = if Set.null t
                         then Map.delete i mp
                         else Map.insert i t  mp
                mp'' = if Set.null t'
                         then Map.delete j mp'
                         else Map.insert j t' mp'
            Just (show i, (mp'', j))
      answer = unfoldr search (pathes, start)
  putStrLn $ intercalate " " answer

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  let readInts = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : _ <- readInts
  let check acc _ = do
        x : y : _ <- readInts
        let acc'  = Map.insertWith (Set.union) y (Set.singleton x) acc
            acc'' = Map.insertWith (Set.union) x (Set.singleton y) acc'
        return acc''
  pathes <- foldM check Map.empty [1 .. n]
  let Just (start, _) = find ((== 1) . Set.size . snd)
        $ Map.toList pathes
      search (mp, i)
        | i < 0       = Nothing
        | Map.null mp = Just (show i, (mp, -1))
        | otherwise   = do
            let s     = mp Map.! i
                j : _ = Set.toList s
                s'    = mp Map.! j
                t     = Set.delete j s
                t'    = Set.delete i s'
                mp'  = if Set.null t
                         then Map.delete i mp
                         else Map.insert i t  mp
                mp'' = if Set.null t'
                         then Map.delete j mp'
                         else Map.insert j t' mp'
            Just (show i, (mp'', j))
      answer = unfoldr search (pathes, start)
  putStrLn $ intercalate " " answer

import Data.List
import qualified Data.IntMap as IM
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe(fromJust)
import GHC.Exts(groupWith)

main = do
  (s:ss) <- fmap (BS.lines) BS.getContents
  let n = readInt s
      input = map(map readInt . BS.words) . take n $ ss
      list = map (\ [x,y] -> (x,y)) input ++
             map (\ [x,y] -> (y,x)) input
      joinedList = map merge . groupWith fst $ list
       where merge l = (fst (head l), map snd l)

      allVertices = map head . group . sort . concat $ input
      [start,end] = map fst . filter ((<2) . length . snd) $ joinedList
      joinedMap = IM.fromList joinedList
      ans = takeWhile(/=end) . map fst $ iterate step (start, -1)
      step (u, prev) = let
        Just adj = IM.lookup u joinedMap
        [v] = adj \\ [prev]
        in (v,u)

  putStrLn . unwords . map show $ ans ++ [end]

readInt = fst . fromJust . BS.readInt

import Data.List
import qualified Data.IntMap as IM
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe(fromJust)
import GHC.Exts(groupWith)

main = do
  (s:ss) <- fmap (BS.lines) BS.getContents
  let n = readInt s
      input = map(map readInt . BS.words) . take n $ ss
      list = map (\ [x,y] -> (x,y)) input ++
             map (\ [x,y] -> (y,x)) input
      joinedList = map merge . groupWith fst $ list
       where merge l = (fst (head l), map snd l)

      allVertices = map head . group . sort . concat $ input
      [start,end] = map fst . filter ((<2) . length . snd) $ joinedList
      joinedMap = IM.fromList joinedList
      ans = takeWhile(/=end) . map fst $ iterate step (start, -1)
      step (u, prev) = let
        Just adj = IM.lookup u joinedMap
        [v] = adj \\ [prev]
        in (v,u)

  print . IM.toList $ joinedMap
  putStrLn . unwords . map show $ ans ++ [end]

readInt = fst . fromJust . BS.readInt


As you very well know, the whole Universe traditionally uses three-dimensional Cartesian system of coordinates. In this system each point corresponds to three real coordinates (x, y, z). In this coordinate system, the distance between the center of the Universe and the point is calculated by the following formula: . Mushroom scientists that work for the Great Mushroom King think that the Universe isn't exactly right and the distance from the center of the Universe to a point equals xa·yb·zc.To test the metric of mushroom scientists, the usual scientists offered them a task: find such x, y, z (0 ≤ x, y, z; x + y + z ≤ S), that the distance between the center of the Universe and the point (x, y, z) is maximum possible in the metric of mushroom scientists. The mushroom scientists aren't good at maths, so they commissioned you to do the task.Note that in this problem, it is considered that 00 = 1.

The first line contains a single integer S (1 ≤ S ≤ 103) — the maximum sum of coordinates of the sought point. The second line contains three space-separated integers a, b, c (0 ≤ a, b, c ≤ 103) — the numbers that describe the metric of mushroom scientists.

Print three real numbers — the coordinates of the point that reaches maximum value in the metrics of mushroom scientists. If there are multiple answers, print any of them that meets the limitations. A natural logarithm of distance from the center of the Universe to the given point in the metric of mushroom scientists shouldn't differ from the natural logarithm of the maximum distance by more than 10 - 6. We think that ln(0) =  - ∞.

solve :: String -> String -> [Double]
solve str1 str2 =
    let
        s = a + b + c
        s0 = (read str1)::Double
        [a, b, c] = map (\x -> (read x)::Double) (words str2)
    in
        if s == 0 then [0, 0, 0]
        else [a*s0/s, b*s0/s, c*s0/s]

join delim [] = []
join delim (x:xs) = x ++ delim ++ join delim xs

main =
    do
        str1 <- getLine
        str2 <- getLine
        putStrLn $ join " " (map show (solve str1 str2))

import Monad (liftM)

solve :: Fractional d => d -> d -> d -> d -> (d, d, d)
solve a b c s
  | a + b + c == 0  =  (0, 0, 0)
  | otherwise  =  (a*s / abc, b*s / abc, c*s / abc)
  where
    abc  =  a + b + c

main :: IO ()
main  =  do
    s  <-  readLn
    [a,b,c]  <-  liftM (map read . words) getLine
    let (x,y,z)  =  solve a b c s
    putStrLn $ concat [show x, " ", show y, " ", show z]

import Control.Applicative
import Text.Printf

main = do
  s <- readLn :: IO Double
  [a,b,c] <- map read.words <$> getLine
  if all(0==)[a,b,c]
     then putStrLn "0 0 0"
     else printf "%f %f %f\n" (s*a/(a+b+c)) (s*b/(a+b+c)) (s*c/(a+b+c))

s :: [Integer] -> [Double]
s [s,0,0,0] = [fromIntegral s,0,0.0]
s [s,a,b,c] = [fromIntegral s * fromIntegral a / ss, fromIntegral s * fromIntegral b / ss, fromIntegral s * fromIntegral c / ss] where
 ss = fromIntegral (a + b + c)
main = interact $ unwords . map show . s . map read . words

main = getContents >>= putStrLn. unwords. map show. (\(s:as) -> let ss = s/sum as in if sum as == 0 then replicate 3 0 else map (*ss) as). map read. concat. map words. lines

main = getContents >>= putStrLn. unwords. map show. (\(s:as) -> let ss = s/(sum as) in if sum as == 0 then replicate 3 0 else map (*ss) as). map read. words

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	content <- getContents
	let
		[s, a, b, c] = map (\x -> read x :: Double). concat. map words. lines $ content
		x = max 0 (a*s/ (b + a + c))
		y = max 0 (b*s / (a+b+c))
		z = max 0 ( s - x - y)
	putStrLn $ (show x) ++ " " ++ (show y) ++ " " ++ (show z)

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	content <- getContents
	let
		[s, a, b, c] = map (\x -> read x :: Double). concat. map words. lines $ content
		x = a*s/ (b + a + c)
		y = b*s / (a+b+c)
		z = s - x - y
	putStrLn $ (show x) ++ " " ++ (show y) ++ " " ++ (show z)


Given a sequence of integers a1, ..., an and q queries x1, ..., xq on it. For each query xi you have to count the number of pairs (l, r) such that 1 ≤ l ≤ r ≤ n and gcd(al, al + 1, ..., ar) = xi. is a greatest common divisor of v1, v2, ..., vn, that is equal to a largest positive integer that divides all vi.

The first line of the input contains integer n, (1 ≤ n ≤ 105), denoting the length of the sequence. The next line contains n space separated integers a1, ..., an, (1 ≤ ai ≤ 109). The third line of the input contains integer q, (1 ≤ q ≤ 3 × 105), denoting the number of queries. Then follows q lines, each contain an integer xi, (1 ≤ xi ≤ 109).

For each query print the result in a separate line.

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

main :: IO ()
main = do
  _n <- getLine
  xs <- map readInt.B.words <$> B.getLine
  _q<-getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve xs qs

solve :: [Int] -> [Int] -> [Int64]
solve (x:xs) qs = map (\q->IM.findWithDefault 0 q res) qs
   where
     !res = go (IM.singleton x 1) (IM.singleton x 1) xs
     go !res !memo (x:xs) = go (IM.unionWith(+) res memo') memo' xs
       where
         !memo' = IM.insertWith (+) x 1 $ IM.mapKeysWith (+) (gcd x) memo
     go res _ _ = res


Vasily the bear has got a sequence of positive integers a1, a2, ..., an. Vasily the Bear wants to write out several numbers on a piece of paper so that the beauty of the numbers he wrote out was maximum. The beauty of the written out numbers b1, b2, ..., bk is such maximum non-negative integer v, that number b1 and b2 and ... and bk is divisible by number 2v without a remainder. If such number v doesn't exist (that is, for any non-negative integer v, number b1 and b2 and ... and bk is divisible by 2v without a remainder), the beauty of the written out numbers equals -1. Tell the bear which numbers he should write out so that the beauty of the written out numbers is maximum. If there are multiple ways to write out the numbers, you need to choose the one where the bear writes out as many numbers as possible.Here expression x and y means applying the bitwise AND operation to numbers x and y. In programming languages C++ and Java this operation is represented by "&", in Pascal — by "and".

The first line contains integer n (1 ≤ n ≤ 105). The second line contains n space-separated integers a1, a2, ..., an (1 ≤ a1 < a2 < ... < an ≤ 109).

In the first line print a single integer k (k > 0), showing how many numbers to write out. In the second line print k integers b1, b2, ..., bk — the numbers to write out. You are allowed to print numbers b1, b2, ..., bk in any order, but all of them must be distinct. If there are multiple ways to write out the numbers, choose the one with the maximum number of numbers to write out. If there still are multiple ways, you are allowed to print any of them.

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

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

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

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


Two kittens, Max and Min, play with a pair of non-negative integers x and y. As you can guess from their names, kitten Max loves to maximize and kitten Min loves to minimize. As part of this game Min wants to make sure that both numbers, x and y became negative at the same time, and kitten Max tries to prevent him from doing so.Each kitten has a set of pairs of integers available to it. Kitten Max has n pairs of non-negative integers (ai, bi) (1 ≤ i ≤ n), and kitten Min has m pairs of non-negative integers (cj, dj) (1 ≤ j ≤ m). As kitten Max makes a move, it can take any available pair (ai, bi) and add ai to x and bi to y, and kitten Min can take any available pair (cj, dj) and subtract cj from x and dj from y. Each kitten can use each pair multiple times during distinct moves.Max moves first. Kitten Min is winning if at some moment both numbers a, b are negative simultaneously. Otherwise, the winner of the game is kitten Max. Determine which kitten wins if both of them play optimally.

The first line contains two integers, n and m (1 ≤ n, m ≤ 100 000) — the number of pairs of numbers available to Max and Min, correspondingly. The second line contains two integers x, y (1 ≤ x, y ≤ 109) — the initial values of numbers with which the kittens are playing. Next n lines contain the pairs of numbers ai, bi (1 ≤ ai, bi ≤ 109) — the pairs available to Max. The last m lines contain pairs of numbers cj, dj (1 ≤ cj, dj ≤ 109) — the pairs available to Min.

Print «Max» (without the quotes), if kitten Max wins, or "Min" (without the quotes), if kitten Min wins.

NoteIn the first test from the statement Min can respond to move (2, 3) by move (3, 10), and to move (3, 2) by move (10, 3). Thus, for each pair of Max and Min's moves the values of both numbers x and y will strictly decrease, ergo, Min will win sooner or later.In the second sample test after each pair of Max and Min's moves both numbers x and y only increase, thus none of them will become negative.

{-# LANGUAGE TupleSections, ScopedTypeVariables, BangPatterns #-}
module Main where

import Data.List

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Int
import Data.Maybe
import Data.Functor
--import qualified Diagrams.Prelude as D
--import Diagrams.Backend.SVG.CmdLine

type Point = ((Int64, Int64), Bool)

parse :: Num n => BS.ByteString -> [n]
parse = map (fromInteger . fst . fromJust . BS.readInteger) . BS.words

comp :: Point -> Point -> Ordering
comp ((x1, y1), _) ((x2, y2), _) = compare (x2 * y1) (y2 * x1)

isLeftTurn :: Point -> Point -> Point -> Bool
isLeftTurn ((x1, y1), _) ((x2, y2), _) ((x3, y3), _) =
  (x3 - x2) * (y2 - y1) <= (x2 - x1) * (y3 - y2)

graham :: [Point] -> [Point]
graham (p1:ps) = go ps [p1]
  where
    go [] stack = stack
    go (p:ps) [stack1] = go ps [p,stack1]
    go (p:ps) st@(stack1:stack2:stack) =
      if isLeftTurn stack2 stack1 p then
        if fst stack1 == fst p then go ps (max p stack1:stack2:stack) else  go ps (p:st)
      else go (p:ps) (stack2:stack)

--toDiagram :: [Point] -> D.Diagram B
--toDiagram = mconcat . map (\((x,y),_) -> D.circle 1 D.# D.translate (D.r2 (fromIntegral x, fromIntegral y)))

main = do
  line1 <- BS.getLine
  line2 <- BS.getLine
  let [n, m] :: [Int] = parse line1
      [_,_] :: [Int] = parse line2
  maxInput <- replicateM n $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), True)
  minInput <- replicateM m $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), False)
  let inp' :: [Point] = maxInput ++ minInput
      maxX = maximum $ map (\((x,y),_) -> x) inp'
      maxY = maximum $ map (\((x,y),_) -> y) inp'
      addinp = [((maxX, 0), False), ((0, maxY), False)]
      inp = addinp ++ inp'
      sortedInput = ((0,0), False):sortBy comp inp
      g = graham sortedInput
  --print sortedInput
  putStrLn $ if any snd g then "Max" else "Min"
  --mainWith $ toDiagram sortedInput D.<> (toDiagram g D.# D.fc D.red)

{-# LANGUAGE TupleSections, ScopedTypeVariables, BangPatterns #-}
module Main where

import Data.List

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Int
import Data.Maybe
import Data.Functor

type Point = ((Int64, Int64), Bool)

parse :: Num n => BS.ByteString -> [n]
parse = map (fromInteger . fst . fromJust . BS.readInteger) . BS.words

comp :: Point -> Point -> Ordering
comp ((x1, y1), _) ((x2, y2), _) = compare (x2 * y1) (y2 * x1)

isLeftTurn :: Point -> Point -> Point -> Bool
isLeftTurn ((x1, y1), _) ((x2, y2), _) ((x3, y3), _) =
  (x3 - x2) * (y2 - y1) <= (x2 - x1) * (y3 - y2)

graham :: [Point] -> [Point]
graham (p1:ps) = go ps [p1]
  where
    go [] stack = stack
    go (p:ps) [stack1] = go ps [p,stack1]
    go (p:ps) st@(stack1:stack2:stack) =
      if isLeftTurn stack2 stack1 p then go ps (p:st)
      else go (p:ps) (stack2:stack)

main = do
  line1 <- BS.getLine
  line2 <- BS.getLine
  let [n, m] :: [Int] = parse line1
      [_,_] :: [Int] = parse line2
  maxInput <- replicateM n $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), True)
  minInput <- replicateM m $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), False)
  let inp' :: [Point] = maxInput ++ minInput
      maxX = maximum $ map (\((x,y),_) -> x) inp'
      maxY = maximum $ map (\((x,y),_) -> y) inp'
      addinp = [((maxX, 0), False), ((0, maxY), False)]
      inp = addinp ++ inp'
      sortedInput = ((0,0), False):sortBy comp inp
      g = graham sortedInput
  putStrLn $ if any snd g then "Max" else "Min"
  return ()

{-# LANGUAGE TupleSections, ScopedTypeVariables, BangPatterns #-}
module Main where

import Data.List

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Int
import Data.Maybe
import Data.Functor

type Point = ((Int64, Int64), Bool)

parse :: Num n => BS.ByteString -> [n]
parse = map (fromInteger . fst . fromJust . BS.readInteger) . BS.words

comp :: Point -> Point -> Ordering
comp ((x1, y1), _) ((x2, y2), _) = compare (x2 * y1) (y2 * x1)

isLeftTurn :: Point -> Point -> Point -> Bool
isLeftTurn ((x1, y1), _) ((x2, y2), _) ((x3, y3), _) =
  (x3 - x2) * (y2 - y1) <= (x2 - x1) * (y3 - y2)

graham :: [Point] -> [Point]
graham (p1:ps) = go ps [p1]
  where
    go [] stack = stack
    go (p:ps) [stack1] = go ps [p,stack1]
    go (p:ps) st@(stack1:stack2:stack) =
      if isLeftTurn stack2 stack1 p then go ps (p:st)
      else go (p:ps) (stack2:stack)

main = do
  line1 <- BS.getLine
  line2 <- BS.getLine
  let [n, m] :: [Int] = parse line1
      [_,_] :: [Int] = parse line2
  maxInput <- replicateM n $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), True)
  minInput <- replicateM n $ do
    [a,b] <- parse <$> BS.getLine
    return ((a, b), False)
  let inp' :: [Point] = maxInput ++ minInput
      maxX = maximum $ map (\((x,y),_) -> x) inp'
      maxY = maximum $ map (\((x,y),_) -> y) inp'
      addinp = [((maxX, 0), False), ((0, maxY), False)]
      inp = addinp ++ inp'
      sortedInput = ((0,0), False):sortBy comp inp
      g = graham sortedInput
  putStrLn $ if any snd g then "Max" else "Min"
  return ()


The famous sculptor Cicasso is a Reberlandian spy!These is breaking news in Berlandian papers today. And now the sculptor is hiding. This time you give the shelter to the maestro. You have a protected bunker and you provide it to your friend. You set the security system in such way that only you can open the bunker. To open it one should solve the problem which is hard for others but is simple for you.Every day the bunker generates a codeword s. Every time someone wants to enter the bunker, integer n appears on the screen. As the answer one should enter another integer — the residue modulo 109 + 7 of the number of strings of length n that consist only of lowercase English letters and contain the string s as the subsequence.The subsequence of string a is a string b that can be derived from the string a by removing some symbols from it (maybe none or all of them). In particular any string is the subsequence of itself. For example, the string "cfo" is the subsequence of the string "codeforces".You haven't implemented the algorithm that calculates the correct answers yet and you should do that ASAP.

The first line contains integer m (1 ≤ m ≤ 105) — the number of the events in the test case. The second line contains nonempty string s — the string generated by the bunker for the current day. The next m lines contain the description of the events. The description starts from integer t — the type of the event. If t = 1 consider a new day has come and now a new string s is used. In that case the same line contains a new value of the string s. If t = 2 integer n is given (1 ≤ n ≤ 105). This event means that it's needed to find the answer for the current string s and the value n. The sum of lengths of all generated strings doesn't exceed 105. All of the given strings consist only of lowercase English letters.

For each query of the type 2 print the answer modulo 109 + 7 on the separate line.

NoteIn the first event words of the form "a?" and "?a" are counted, where ? is an arbitrary symbol. There are 26 words of each of these types, but the word "aa" satisfies both patterns, so the answer is 51.

{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
import Data.Functor
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `quot` n) * inverse (modulus `rem` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 1
  writeArray b 0 1
  let f i | i > maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = x*i `rem` modulus
              writeArray a i y
              writeArray b i $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then do
           when (B.length b > threshold) $ compute a b
           go (m-1) b
         else do
           let n = fromIntegral . fst . fromJust $ B.readInt b
               f i pw acc | i < 0 = acc
                          | otherwise = f (i-1) (pw*25 `rem` modulus) $ (acc - binom n i * pw) `rem` modulus
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print $ f (l-1) (powMod 25 (n-l+1)) (powMod 26 n) `mod` modulus
           go (m-1) s
      where
        l = fromIntegral $ B.length s
  go m s

{-# LANGUAGE FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes #-}
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Functor
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `div` n) * inverse (modulus `mod` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 1
  writeArray b 0 1
  let f i | i == maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = x*i `rem` modulus
              writeArray a i y
              writeArray b i $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  s <- B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then
           when (B.length b > threshold) $ compute a b
         else
           let n = fromIntegral . fst . fromJust $ B.readInt b
               f i pw acc | i < 0 = acc
                          | otherwise = f (i-1) (pw*25 `mod` modulus) $ (acc - binom n i * pw) `rem` modulus in
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print $ f (l-1) (powMod 25 (n-l+1)) (powMod 26 n)
      go (m-1) b
      where
        l = fromIntegral $ B.length s
  go m s

{- l == length of the string
- dp[l][i] = dp[l][i]*26 + 25**(i-l)*binom(i-1,l-1)
-}
{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
import Data.Functor
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
antiModulus = 2226617417 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `quot` n) * inverse (modulus `rem` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 $ montgomery 1
  writeArray b 0 $ montgomery 1
  let f i | i > maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = redc x i
              writeArray a i $ montgomery y
              writeArray b i . montgomery $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

montgomery :: Int64 -> Int64
montgomery a = a `shiftL` 32 `mod` modulus

m25 = montgomery 25

unMontgomery :: Int64 -> Int64
unMontgomery a = a * 518424770 `mod` modulus

redc :: Int64 -> Int64 -> Int64
redc a b =
  let t = a*b
      x = (t + (t.&.(2^32-1) * antiModulus .&. (2^32-1) * modulus)) `shiftR` 32 in
  if x >= modulus then x - modulus else x

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then do
           when (B.length b > threshold) $ compute a b
           go (m-1) b
         else do
           let n = fromIntegral . fst . fromJust $ B.readInt b
               (fact, invfact) = factorial
               f i pw acc | i < 0 = acc
                          | otherwise =
                            let !acc' = acc - redc (invfact!(n-i)) (redc (invfact!i) (redc pw (fact!n))) in
                            f (i-1) (redc pw m25) $ if acc' < 0 then acc'+modulus else acc'
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print . unMontgomery $ f (l-1) (montgomery $ powMod 25 (n-l+1)) (montgomery $ powMod 26 n)
           go (m-1) s
      where
        l = fromIntegral $ B.length s
  go m s

{- l == length of the string
- dp[l][i] = dp[l][i]*26 + 25**(i-l)*binom(i-1,l-1)
-}
{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
import Data.Functor
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
antiModulus = 2226617417 :: Int64
threshold = 500

{-# INLINE inverse #-}
inverse :: Int64 -> Int64
inverse a = go a 1
  where
    go a s | a == 1 = s
           | otherwise = go (modulus `rem` a) $ (modulus - modulus `quot` a) * s `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 $ montgomery 1
  writeArray b 0 $ montgomery 1
  let f i | i > maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = redc x i
              writeArray a i $ montgomery y
              writeArray b i . montgomery $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

{-# INLINE binom #-}
binom :: Int64 -> Int64 -> Int64
binom n m = unMontgomery $ redc (redc (fact!n) (inv!m)) (inv!(n-m))
  where
    (fact, inv) = factorial

{-# INLINE powMod #-}
powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

{-# INLINE montgomery #-}
montgomery :: Int64 -> Int64
montgomery a = a `shiftL` 32 `mod` modulus

m25 = montgomery 25

{-# INLINE unMontgomery #-}
unMontgomery :: Int64 -> Int64
unMontgomery a = a * 518424770 `mod` modulus

redc :: Int64 -> Int64 -> Int64
redc a b =
  let t = a*b
      x = (t + (t.&.(2^32-1) * antiModulus .&. (2^32-1) * modulus)) `shiftR` 32 in
  if x >= modulus then x - modulus else x

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then do
           when (B.length b > threshold) $ compute a b
           go (m-1) b
         else do
           let n = fromIntegral . fst . fromJust $ B.readInt b
               (fact, invfact) = factorial
               f i pw acc | i < 0 = acc
                          | otherwise =
                            let !acc' = acc - binom n i in
                            f (i-1) (redc pw m25) $ if acc' < 0 then acc'+modulus else acc'
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print . unMontgomery $ f (l-1) (montgomery $ powMod 25 (n-l+1)) (montgomery $ powMod 26 n)
           go (m-1) s
      where
        l = fromIntegral $ B.length s
  go m s

{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Functor
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `quot` n) * inverse (modulus `rem` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 1
  writeArray b 0 1
  let f i | i == maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = x*i `rem` modulus
              writeArray a i y
              writeArray b i $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then do
           when (B.length b > threshold) $ compute a b
           go (m-1) b
         else do
           let n = fromIntegral . fst . fromJust $ B.readInt b
               f i pw acc | i < 0 = acc
                          | otherwise = f (i-1) (pw*25 `rem` modulus) $ (acc - binom n i * pw) `rem` modulus
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print $ f (l-1) (powMod 25 (n-l+1)) (powMod 26 n) `mod` modulus
           go (m-1) s
      where
        l = fromIntegral $ B.length s
  go m s

{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Functor
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `div` n) * inverse (modulus `mod` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 1
  writeArray b 0 1
  let f i | i == maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = x*i `rem` modulus
              writeArray a i y
              writeArray b i $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then
           when (B.length b > threshold) $ compute a b
         else
           let n = fromIntegral . fst . fromJust $ B.readInt b
               f i pw acc | i < 0 = acc
                          | otherwise = f (i-1) (pw*25 `mod` modulus) $ (acc - binom n i * pw) `rem` modulus in
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print $ f (l-1) (powMod 25 (n-l+1)) (powMod 26 n)
      go (m-1) b
      where
        l = fromIntegral $ B.length s
  go m s

{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, RankNTypes, Safe #-}
import Control.Monad
#if __GLASGOW_HASKELL__ >= 710
import Control.Monad.ST
#else
import Control.Monad.ST.Safe
#endif
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Functor
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Text.Printf

maxN = 100000
modulus = 1000000007 :: Int64
threshold = 500

inverse :: Int64 -> Int64
inverse 1 = 1
inverse n = (modulus - modulus `quot` n) * inverse (modulus `rem` n) `rem` modulus

factorial :: (UArray Int64 Int64, UArray Int64 Int64)
factorial = runST $ do
  a <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  b <- newArray_ (0, maxN) :: ST s (STUArray s Int64 Int64)
  writeArray a 0 1
  writeArray b 0 1
  let f i | i == maxN = return ()
          | otherwise = do
              x <- readArray a (i-1)
              let y = x*i `rem` modulus
              writeArray a i y
              writeArray b i $ inverse y
              f (i+1)
  f 1
  liftM2 (,) (freeze a) (freeze b)

binom :: Int64 -> Int64 -> Int64
binom n m = fact!n * inv!m `rem` modulus * inv!(n-m) `rem` modulus
  where
    (fact, inv) = factorial

powMod :: Int64 -> Int -> Int64
powMod a n = go a n 1
  where
    go _ 0 s = s
    go a n s = go (a*a `rem` modulus) (n `div` 2) (if even n then s else s*a `rem` modulus)

compute :: IOUArray Int64 Int64 -> B.ByteString -> IO ()
compute a s = f 0 1
  where
    l = fromIntegral $ B.length s
    f i pw | i < l = writeArray a i 0 >> f (i+1) pw
           | i <= maxN = do
              t <- readArray a (i-1)
              writeArray a i $ (t * 26 + binom (i-1) (l-1) * pw) `rem` modulus
              f (i+1) (pw*25 `rem` modulus)
           | otherwise = return ()

main = do
  m <- readLn :: IO Int
  a <- newArray_ (0, maxN) :: IO (IOUArray Int64 Int64)
  [s] <- B.words <$> B.getLine
  when (B.length s > threshold) $ compute a s
  let
    go 0 _ = return ()
    go m s = do
      [op, b] <- B.words <$> B.getLine
      if op == "1"
         then
           when (B.length b > threshold) $ compute a b
         else
           let n = fromIntegral . fst . fromJust $ B.readInt b
               f i pw acc | i < 0 = acc
                          | otherwise = f (i-1) (pw*25 `rem` modulus) $ (acc - binom n i * pw) `rem` modulus in
           if | l > threshold -> readArray a n >>= print
              | n < l -> print 0
              | otherwise -> print $ f (l-1) (powMod 25 (n-l+1)) (powMod 26 n) `mod` modulus
      go (m-1) b
      where
        l = fromIntegral $ B.length s
  go m s


Sereja loves number sequences very much. That's why he decided to make himself a new one following a certain algorithm.Sereja takes a blank piece of paper. Then he starts writing out the sequence in m stages. Each time he either adds a new number to the end of the sequence or takes l first elements of the current sequence and adds them c times to the end. More formally, if we represent the current sequence as a1, a2, ..., an, then after we apply the described operation, the sequence transforms into a1, a2, ..., an[, a1, a2, ..., al] (the block in the square brackets must be repeated c times). A day has passed and Sereja has completed the sequence. He wonders what are the values of some of its elements. Help Sereja.

The first line contains integer m (1 ≤ m ≤ 105) — the number of stages to build a sequence.  Next m lines contain the description of the stages in the order they follow. The first number in the line is a type of stage (1 or 2). Type 1 means adding one number to the end of the sequence, in this case the line contains integer xi (1 ≤ xi ≤ 105) — the number to add. Type 2 means copying a prefix of length li to the end ci times, in this case the line further contains two integers li, ci (1 ≤ li ≤ 105, 1 ≤ ci ≤ 104), li is the length of the prefix, ci is the number of copyings. It is guaranteed that the length of prefix li is never larger than the current length of the sequence. The next line contains integer n (1 ≤ n ≤ 105) — the number of elements Sereja is interested in. The next line contains the numbers of elements of the final sequence Sereja is interested in. The numbers are given in the strictly increasing order. It is guaranteed that all numbers are strictly larger than zero and do not exceed the length of the resulting sequence. Consider the elements of the final sequence numbered starting from 1 from the beginning to the end of the sequence. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

Print the elements that Sereja is interested in, in the order in which their numbers occur in the input.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf
import Data.STRef

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

readInt = fromJust . fmap fst . B.readInt
readInteger = fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntegers = map readInteger . B.words <$> B.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)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

data Op = Op1 Int | Op2 Int Int
main = do
    m <- readLn
    ops <- replicateM m $ do
        l <- readInts
        return $ case l of
            [1,x] -> Op1 x
            [2,l,c] -> Op2 l c
    n <- readLn
    ds <- readIntegers
    let l = solve m ops n ds
    putStrLn $ unwords $ map show l

limit :: Num a => a
limit = 10^5

solve :: Int -> [Op] -> Int -> [Integer] -> [Int]
solve n ops m ds = map f ds
    where
    ss :: Array Int Integer
    ss = listArray (0,n) $ lenList ops
    ops' :: Array Int Op
    ops' = listArray (1,n) $ ops
    ar = genList ops
    f di | di <= limit  = ar ! (fromInteger di-1)
         | otherwise = case ops' ! j of
                Op1 x -> x
                Op2 l c -> ar ! (fromInteger (mod (di - 1 - ss ! (j-1))
                                                  (fromIntegral l)))
            where
                j = findPos ss (di-1)
findPos :: Array Int Integer -> Integer -> Int
findPos _ 0 = 1
findPos arr d = go 0 (snd $ bounds arr)
    where
        go l r | l == r - 1 = r
               | arr ! m <= d = go m r
               | otherwise = go l m
            where m = div (l + r) 2

lenList :: [Op] -> [Integer]
lenList ops = go 0 ops
    where
        go s (Op1 _:ops) = s:go (s+1) ops
        go s (Op2 l c:ops) = s:go (s+fromIntegral (l*c)) ops
        go s _ = [s]

genList :: [Op] -> UArray Int Int
genList ops = runSTUArray $ do
    arr <- newArray (0,limit) (-1)
    iref  <- newSTRef 0
    forM_ ops $ \op -> case op of
        Op1 x -> do
            i <- readSTRef iref
            when (i <= limit) $ do
                writeArray arr i x
                writeSTRef iref (i+1)
        Op2 l c -> do
            i <- readSTRef iref
            forM_ [i..min (limit) (i + l*c-1)] $ \j -> do
                a <- readArray arr (mod (j - i) l)
                writeArray arr j a
                writeSTRef iref (j+1)
    return arr


Iahub is playing an uncommon game. Initially, he has n boxes, numbered 1, 2, 3, ..., n. Each box has some number of candies in it, described by a sequence a1, a2, ..., an. The number ak represents the number of candies in box k. The goal of the game is to move all candies into exactly two boxes. The rest of n - 2 boxes must contain zero candies. Iahub is allowed to do several (possible zero) moves. At each move he chooses two different boxes i and j, such that ai ≤ aj. Then, Iahub moves from box j to box i exactly ai candies. Obviously, when two boxes have equal number of candies, box number j becomes empty.Your task is to give him a set of moves such as Iahub to archive the goal of the game. If Iahub can't win the game for the given configuration of boxes, output -1. Please note that in case there exist a solution, you don't need to print the solution using minimal number of moves.

The first line of the input contains integer n (3 ≤ n ≤ 1000). The next line contains n non-negative integers: a1, a2, ..., an — sequence elements. It is guaranteed that sum of all numbers in sequence a is up to 106.

In case there exists no solution, output -1. Otherwise, in the first line output integer c (0 ≤ c ≤ 106), representing number of moves in your solution. Each of the next c lines should contain two integers i and j (1 ≤ i, j ≤ n, i ≠ j): integers i, j in the kth line mean that at the k-th move you will move candies from the j-th box to the i-th one.

NoteFor the first sample, after the first move the boxes will contain 3, 12 and 3 candies. After the second move, the boxes will contain 6, 12 and 0 candies. Now all candies are in exactly 2 boxes.For the second sample, you can observe that the given configuration is not valid, as all candies are in a single box and they should be in two boxes. Also, any move won't change the configuration, so there exists no solution.For the third sample, all candies are already in 2 boxes. Hence, no move is needed.

import Data.List
import Data.Bits

bitLen n = until (\k -> bit k > n) (+ 1) 0

solve3 acc a0 b0 c0 =
    let [a, b, c] = sort [a0, b0, c0]
        (q, r) = fst b `divMod` fst a
        k = bitLen q
    in if fst a == 0
            then (acc, b, c)
            else let acc' = foldl (\ms i -> (snd a, if testBit q i then snd b else snd c):ms) acc [0..k - 1]
                 in solve3 acc' (fst a * bit k, snd a) (r, snd b) (fst c - fst a * (bit k - 1 - q), snd c)

solve' (a0:a1:as) = let (ms, _, _) = foldl (\(ms, a, b) c -> solve3 ms a b c) ([], a0, a1) as in reverse ms
solve' as = []

solve as = case filter (\p -> fst p > 0) $ zip as [0..] of
            l@(a0:a1:as) -> Just $ solve' (l :: [(Int, Int)])
            _ -> Nothing

main = putStr . display . solve . readInput =<< getContents

readInput = map read . tail . words

display (Just ms) = show (length ms) ++ "\n" ++ concatMap (\(i, j) -> show (i + 1) ++ " " ++ show (j + 1) ++ "\n") ms
display Nothing = "-1\n"


Peter likes to travel by train. He likes it so much that on the train he falls asleep. Once in summer Peter was going by train from city A to city B, and as usual, was sleeping. Then he woke up, started to look through the window and noticed that every railway station has a flag of a particular colour.The boy started to memorize the order of the flags' colours that he had seen. But soon he fell asleep again. Unfortunately, he didn't sleep long, he woke up and went on memorizing the colours. Then he fell asleep again, and that time he slept till the end of the journey.At the station he told his parents about what he was doing, and wrote two sequences of the colours that he had seen before and after his sleep, respectively.Peter's parents know that their son likes to fantasize. They give you the list of the flags' colours at the stations that the train passes sequentially on the way from A to B, and ask you to find out if Peter could see those sequences on the way from A to B, or from B to A. Remember, please, that Peter had two periods of wakefulness.Peter's parents put lowercase Latin letters for colours. The same letter stands for the same colour, different letters — for different colours.

The input data contains three lines. The first line contains a non-empty string, whose length does not exceed 105, the string consists of lowercase Latin letters — the flags' colours at the stations on the way from A to B. On the way from B to A the train passes the same stations, but in reverse order.  The second line contains the sequence, written by Peter during the first period of wakefulness. The third line contains the sequence, written during the second period of wakefulness. Both sequences are non-empty, consist of lowercase Latin letters, and the length of each does not exceed 100 letters. Each of the sequences is written in chronological order.

Output one of the four words without inverted commas:    «forward» — if Peter could see such sequences only on the way from A to B;  «backward» — if Peter could see such sequences on the way from B to A;  «both» — if Peter could see such sequences both on the way from A to B, and on the way from B to A;  «fantasy» — if Peter could not see such sequences.

NoteIt is assumed that the train moves all the time, so one flag cannot be seen twice. There are no flags at stations A and B.

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

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