During her tantrums the princess usually smashes some collectable porcelain. Every furious shriek is accompanied with one item smashed.The collection of porcelain is arranged neatly on n shelves. Within each shelf the items are placed in one row, so that one can access only the outermost items — the leftmost or the rightmost item, not the ones in the middle of the shelf. Once an item is taken, the next item on that side of the shelf can be accessed (see example). Once an item is taken, it can't be returned to the shelves.You are given the values of all items. Your task is to find the maximal damage the princess' tantrum of m shrieks can inflict on the collection of porcelain.

The first line of input data contains two integers n (1 ≤ n ≤ 100) and m (1 ≤ m ≤ 10000). The next n lines contain the values of the items on the shelves: the first number gives the number of items on this shelf (an integer between 1 and 100, inclusive), followed by the values of the items (integers between 1 and 100, inclusive), in the order in which they appear on the shelf (the first number corresponds to the leftmost item, the last one — to the rightmost one). The total number of items is guaranteed to be at least m.

Output the maximal total value of a tantrum of m shrieks.

NoteIn the first case there are two shelves, each with three items. To maximize the total value of the items chosen, one can take two items from the left side of the first shelf and one item from the right side of the second shelf.In the second case there is only one shelf, so all three items are taken from it — two from the left side and one from the right side.

import Data.Array.IO
import Data.Array.IArray ((!),bounds)
import Data.Array.Unboxed (UArray,listArray)
import Control.Monad

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

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

shelfBest :: [Int] -> UArray Int Int
shelfBest (len:ps) = listArray (0,len) (reverse init)
   where sumX = sum ps
         init = sumX : go ps
         go :: [Int] -> [Int]
         go [] = []
         go xs'@(_:t) = (sumX - minimum xs') : go (zipWith (+) ps t)

upperBound arr = snd $ bounds arr

best:: UArray Int Int -> UArray Int Int -> Int -> Int
best a1 a2 m = maximum $ map go [lo..hi]
  where lo = max 0 (m - upperBound a1)
        hi = min m (upperBound a2)
        go k = a1!(m-k) + a2!k

step :: UArray Int Int -> UArray Int Int -> UArray Int Int
step prev curr = next
  where hi = upperBound prev + upperBound curr
        next = listArray (0,hi) $ map (best prev curr) [0..hi]

solve m shelves =
  let arr = foldl1 step $ map shelfBest shelves
      i = min (upperBound arr) m
      in arr!i

main = do
  (n:m:_) <- fmap (map read . words) getLine
  -- shelves <- replicateM n $ fmap readNums BS.getLine
  shelves <- replicateM n $ fmap (map read . words) getLine
  let answer = solve m shelves
  print answer

import Data.Array
import Control.Monad

type Result = Array Int Int

shelfBest :: [Int] -> Result
shelfBest (len:ps) = listArray (0,len) (reverse init)
   where sumX = sum ps
         init = sumX : go ps
         go :: [Int] -> [Int]
         go [] = []
         go xs'@(_:t) = (sumX - minimum xs') : go (zipWith (+) ps t)

upperBound arr = snd $ bounds arr

best:: Result -> Result -> Int -> Int
best a1 a2 m = maximum $ map go [lo..hi]
  where lo = max 0 (m - upperBound a1)
        hi = min m (upperBound a2)
        go k = a1!(m-k) + a2!k

step :: Result -> Result -> Result
step prev curr = next
  where hi = upperBound prev + upperBound curr
        next = listArray (0,hi) $ map (best prev curr) [0..hi]

solve m shelves =
  let arr = foldl1 step $ map shelfBest shelves
      i = min (upperBound arr) m
      in arr!i

main = do
  (n:m:_) <- fmap (map read . words) getLine
  -- shelves <- replicateM n $ fmap readNums BS.getLine
  shelves <- replicateM n $ fmap (map read . words) getLine
  let answer = solve m shelves
  print answer

import Data.List
import Data.Array
import Data.Function

type Result = Array Int Int

transform :: [Int]->Result
transform (count:xs) = listArray (0,count).reverse$sumX:go xs where
	go [] = []
	go xs'@(h:t) = (sumX - minimum xs'):go (zipWith (+) xs t)
	sumX = sum xs

uB = snd.bounds

best a1 a2 cries = maximum.map calc$[max 0.(cries-).uB$a1..min cries.uB$a2]
	where calc split = a1!(cries-split) + a2!split

merge :: Result->Result->Result
merge a1 a2 = listArray (0,newMax).map (best a1 a2)$[0..newMax]
	where newMax = uB a1 + uB a2

result :: [[Int]]->Int
result ([n,m]:ss) = (!m).foldl1 merge.map transform$ss

main=interact$show.result.map (map read.words).lines

import Data.Array.IO
import Data.Array (listArray)
import Data.Array.IArray ((!),bounds)
import Data.Array.Unboxed (UArray)
import Data.Array.MArray (freeze)
import Control.Monad

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

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

shelfBest m ps = do
  let len = length ps

  let nums = listArray (1,len) ps

  lsums <- newArray (0,m) 0 :: IO (IOUArray Int Int)
  let kmax = min m len
  forM_ [1..kmax] $ \i -> do
    v <- readArray lsums (i-1)
    writeArray lsums i (v+nums!i)

  rsums <- newArray (0,m) 0 :: IO (IOUArray Int Int)
  forM_ [1..kmax] $ \i -> do
    v <- readArray rsums (i-1)
    writeArray rsums i (v+nums!(len+1-i))

  lsums' <- freeze lsums :: IO (UArray Int Int)
  rsums' <- freeze rsums :: IO (UArray Int Int)

  best <- newArray (0,kmax) 0 :: IO (IOUArray Int Int)
  forM_ [1..kmax] $ \k -> do
    let a = maximum [ (lsums'!i) + (rsums'!(k-i)) | i <- [0..k] ]
    writeArray best k a
  freeze best :: IO (UArray Int Int)

step m prev ps = do
  curr <- shelfBest m ps
  let (plo,phi) = bounds prev
  let (clo,chi) = bounds curr
      mmax = min m (chi+phi)
  next <- newArray (0,mmax) 0 :: IO (IOUArray Int Int)
  forM_ [1..mmax] $ \k -> do
    let a = maximum [ (prev!i') + (curr!j') | i <- [0..k], let i' = min i phi, let j' = min (k-i) chi ]
    writeArray next k a
  freeze next :: IO (UArray Int Int)

solve m (ps:rest) = do
  prev <- shelfBest m ps
  let loop arr [] = return arr
      loop arr (ps:pss) = step m arr ps
  arr <- loop prev rest
  let (lo,hi) = bounds arr
      i = min m hi
      answer = arr!i
  return answer

readNums :: ByteString -> [Int]
readNums bs = case BS.readInt (BS.dropWhile isSpace bs) of
                Nothing -> []
                Just (n,bs') -> parseInts n bs'

main = do
  (n:m:_) <- fmap (map read . words) getLine
  shelves <- replicateM n $ fmap readNums BS.getLine
  solve m shelves >>= print


The new camp by widely-known over the country Spring Programming Camp is going to start soon. Hence, all the team of friendly curators and teachers started composing the camp's schedule. After some continuous discussion, they came up with a schedule $$$s$$$, which can be represented as a binary string, in which the $$$i$$$-th symbol is '1' if students will write the contest in the $$$i$$$-th day and '0' if they will have a day off.At the last moment Gleb said that the camp will be the most productive if it runs with the schedule $$$t$$$ (which can be described in the same format as schedule $$$s$$$). Since the number of days in the current may be different from number of days in schedule $$$t$$$, Gleb required that the camp's schedule must be altered so that the number of occurrences of $$$t$$$ in it as a substring is maximum possible. At the same time, the number of contest days and days off shouldn't change, only their order may change.Could you rearrange the schedule in the best possible way?

The first line contains string $$$s$$$ ($$$1 \leqslant |s| \leqslant 500\,000$$$), denoting the current project of the camp's schedule. The second line contains string $$$t$$$ ($$$1 \leqslant |t| \leqslant 500\,000$$$), denoting the optimal schedule according to Gleb. Strings $$$s$$$ and $$$t$$$ contain characters '0' and '1' only.

In the only line print the schedule having the largest number of substrings equal to $$$t$$$. Printed schedule should consist of characters '0' and '1' only and the number of zeros should be equal to the number of zeros in $$$s$$$ and the number of ones should be equal to the number of ones in $$$s$$$. In case there multiple optimal schedules, print any of them.

NoteIn the first example there are two occurrences, one starting from first position and one starting from fourth position.In the second example there is only one occurrence, which starts from third position. Note, that the answer is not unique. For example, if we move the first day (which is a day off) to the last position, the number of occurrences of $$$t$$$ wouldn't change.In the third example it's impossible to make even a single occurrence.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

type IntArray = Array Int Int
type ByteString = BS8.ByteString
(!.) = BS8.index

getMinSuffix :: ByteString -> ByteString
getMinSuffix str = BS8.drop (pi ! (n - 1)) str where
    n = BS8.length str
    pi = listArray (0, n - 1) $ 0 : [ prefixFunction str pi i | i <- [1 .. n - 1] ]

prefixFunction :: ByteString -> IntArray -> Int -> Int
prefixFunction str pi i = if str !. i == str !. j' then (j' + 1) else j' where
    j = pi ! (i - 1)
    j' = backtrack j
    backtrack k = if k > 0 && str !. i /= str !. k then backtrack (pi ! (k - 1)) else k

process :: ByteString -> ByteString -> ByteString
process s t = let
    suffix = getMinSuffix t
    (sZero, sOne) = countZeroOne s
    (tZero, tOne) = countZeroOne t
    (fZero, fOne) = countZeroOne suffix
    tryWhole = if tZero <= sZero && tOne <= sOne
        then Just (t, (sZero - tZero, sOne - tOne))
        else Nothing
    addSubstr (str, (zero, one)) = Just result where
        mZero = if fZero == 0 then 0 else zero `div` fZero
        mOne = if fOne == 0 then 0 else one `div` fOne
        repCnt = min mZero mOne
        rZero = zero - fZero * repCnt
        rOne = one - fOne * repCnt
        result = str <> BS8.concat (replicate repCnt suffix) <> BS8.replicate rZero '0' <> BS8.replicate rOne '1' in
    case tryWhole >>= addSubstr of
        Just result -> result
        Nothing -> s

countZeroOne str = (zeroCount, oneCount) where
    zeroCount = BS8.count '0' str
    oneCount = BS8.length str - zeroCount

main = do
    s <- nocr <$> BS8.getLine
    t <- nocr <$> BS8.getLine
    BS8.putStrLn $ process s t

nocr str = if BS8.last str == '\r' then BS8.init str else str

module Main where

import Control.Applicative
import Control.Monad.State
import Data.Int
import Data.Maybe
import Data.Semigroup

import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as L

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

data KmpState a =
  KS a [a] (KmpState a)
  | KM a [a] (KmpState a) (KmpState a)
  | KEND (KmpState a)

kMatch :: Eq a => a -> KmpState a -> Bool
kMatch _ KEND{} = False
kMatch x (KM y _ _ _) = x == y
kMatch x (KS y _ _ ) = x == y

kNext :: KmpState a -> KmpState a
kNext KEND{} = error "Already the end of KMP state."
kNext (KS _ _ n) = n
kNext (KM _ _ _ n) = n

kFail :: KmpState a -> KmpState a
kFail (KEND f) = f
kFail (KM _ _ f _) = f
kFail s@KS{} = s

kFailToList :: (a -> b) -> KmpState a -> [b]
kFailToList f s = case s of
  KEND p -> [f (e p)]
  KS a _ n -> f a : kFailToList f n
  KM _ _ p n -> f (e p) : kFailToList f n
  where
    e KEND{} = error "Impossible"
    e (KS k _ _) = k
    e (KM k _ _ _) = k

kGetSuffix :: KmpState a -> [a]
kGetSuffix KEND{} = []
kGetSuffix (KS _ as _) = as
kGetSuffix (KM _ as _ _) = as

kLast :: KmpState a -> KmpState a
kLast a@KEND{} = a
kLast a = kLast $ kNext a

-- getKmp :: Eq a => [a] -> KmpState a
-- getKmp [] = KEND (getKmp [])
-- getKmp z@(x:xs) = KS x z (kmp' xs self)
--   where
--     self = getKmp z
--
--     kmp' [] curFail = KEND curFail
--     kmp' t@(r:rs) curFail = KM r t curFail (kmp' rs nextFail)
--       where
--         nextFail = tryMatch curFail
--
--         tryMatch st
--           | kMatch r st = kNext st
--           | u@KS{} <- st = u
--           | u@KM{} <- st = tryMatch $ kFail u
--           | KEND{} <- st = error "Try to match end of KMP state"

getKmp :: Eq a => [a] -> KmpState a
getKmp [] = r
  where
    r = KEND r
getKmp z@(x:xs) = q
  where
    q = KS x z $ kmp' xs q

    kmp' [] curFail = KEND curFail
    kmp' t@(r:rs) curFail =  KM r t curFail $ kmp' rs nextFail
      where
        nextFail = tryMatch curFail

        tryMatch st
          | kMatch r st = kNext st
          | u@KS{} <- st = u
          | u@KM{} <- st = tryMatch $ kFail u
          | KEND{} <- st = error "Try to match end of KMP state"

stripWindowsLB :: BS.ByteString -> BS.ByteString
stripWindowsLB a = if BS.isSuffixOf (BS.pack "\r") a
  then fromJust $ BS.stripSuffix (BS.pack "\r") a
  else a

type LineReader a = State [BS.ByteString] a

currentLine :: LineReader BS.ByteString
currentLine = do
  ls <- get
  let (x, xs) = case ls of
        [] -> error "No remain lines."
        l -> (head l, tail l)
  put xs
  return x

restLines :: LineReader [BS.ByteString]
restLines = do
  xs <- get
  put []
  return xs

runLineReader :: LineReader a -> [BS.ByteString] -> (a, [BS.ByteString])
runLineReader reader ls = runState reader (map stripWindowsLB ls)

data Count = C {c0 :: Int32, c1 :: Int32}

getCount :: String -> Count
getCount = L.foldl' inc (C 0 0)
  where
    inc p@(C r0 r1) c = if c == '0' then p{c0 = r0 + 1} else p{c1 = r1 + 1}

toString :: Count -> String
toString (C x y) = replicate (fromIntegral x) '0'
  ++ replicate (fromIntegral y) '1'

solve :: String -> String -> String
solve s t
  | [] <- t = s
  | cs0 < ct0 || cs1 < ct1 = s
  | otherwise = t
      ++ mconcat (replicate numOcc lastSuffix)
      ++ toString crest
  where
    tKmp = getKmp t
    lastSuffix = kGetSuffix $ kFail $ kLast tKmp
    (C ct0 ct1) = getCount t
    (C cs0 cs1) = getCount s
    (C cts0 cts1) = getCount lastSuffix
    numOcc = maybeMin (f cs0 ct0 cts0) (f cs1 ct1 cts1)
    crest = C
      (cs0 - ct0 - cts0 * fromIntegral numOcc)
      (cs1 - ct1 - cts1 * fromIntegral numOcc)
    f cs ct cts = fmap fromIntegral $
      if cts == 0 then Nothing else Just $ (cs - ct) `div` cts

    maybeMin Nothing (Just x) = x
    maybeMin (Just x) Nothing = x
    maybeMin (Just x) (Just y) = min x y

main :: IO ()
main = do
  ls <- readLines
  let ((sl1, sl2), _) = flip runLineReader ls $ do
        rls <- restLines
        case rls of
          l1:l2:_ -> return (BS.unpack l1, BS.unpack l2)
          _ -> error ""
  -- let a = kFailToList id $ getKmp $ zipWith Arg sl2 [1..] :: [Arg Char Int]
  -- print $ map (\(Arg _ b) -> b) a
  putStrLn $ solve sl1 sl2

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

type IntArray = Array Int Int
type ByteString = BS8.ByteString
(!.) = BS8.index

getMinSuffix :: ByteString -> ByteString
getMinSuffix str = BS8.drop (pi ! (n - 1)) str where
    n = BS8.length str
    pi = listArray (0, n - 1) $ 0 : [ prefixFunction str pi i | i <- [1 .. n - 1] ]

prefixFunction :: ByteString -> IntArray -> Int -> Int
prefixFunction str pi i = if str !. i == str !. j' then (j' + 1) else j' where
    j = pi ! (i - 1)
    j' = backtrack j
    backtrack k = if k > 0 && str !. i /= str !. k then backtrack (pi ! (k - 1)) else k

process :: ByteString -> ByteString -> ByteString
process s t = let
    suffix = getMinSuffix t
    (sZero, sOne) = countZeroOne s
    (tZero, tOne) = countZeroOne t
    (fZero, fOne) = countZeroOne suffix
    tryWhole = if tZero <= sZero && tOne <= sOne
        then Just (t, (sZero - tZero, sOne - tOne))
        else Nothing
    addSubstr (str, (zero, one)) = if fZero <= zero && fOne <= one
        then addSubstr ((str <> suffix), (zero - fZero, one - fOne))
        else str <> BS8.replicate zero '0' <> BS8.replicate one '1' in
    case tryWhole >>= return . addSubstr of
        Just result -> result
        Nothing -> s

countZeroOne str = (zeroCount, oneCount) where
    zeroCount = BS8.count '0' str
    oneCount = BS8.length str - zeroCount

main = do
    s <- BS8.getLine
    t <- BS8.getLine
    BS8.putStrLn $ process s t

nocr str = if BS8.last str == '\r' then BS8.init str else str

module Main where

import Control.Applicative
import Control.Monad.State
import Data.Int
import Data.Maybe

import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as L

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

data KmpState a =
  KS a [a] (KmpState a)
  | KM a [a] (KmpState a) (KmpState a)
  | KEND

kMatch :: Eq a => a -> KmpState a -> Bool
kMatch _ KEND = False
kMatch x (KM y _ _ _) = x == y
kMatch x (KS y _ _ ) = x == y

kNext :: KmpState a -> KmpState a
kNext KEND = error "Already the end of KMP state."
kNext (KS _ _ n) = n
kNext (KM _ _ _ n) = n

kFail :: KmpState a -> KmpState a
kFail KEND = error "Already the end of KMP state."
kFail (KM _ _ f _) = f
kFail s@KS{} = s

kFailToList :: (a -> b) -> KmpState a -> [b]
kFailToList _ KEND = []
kFailToList f (KS a _ n) = f a : kFailToList f n
kFailToList f (KM _ _ p n) = f (e p) : kFailToList f n
  where
    e KEND = error "Impossible"
    e (KS k _ _) = k
    e (KM k _ _ _) = k

kGetSuffix :: KmpState a -> [a]
kGetSuffix KEND = []
kGetSuffix (KS _ as _) = as
kGetSuffix (KM _ as _ _) = as

kLast :: KmpState a -> KmpState a
kLast KEND = KEND
kLast a@(KS _ _ KEND) = a
kLast a@(KM _ _ _ KEND) = a
kLast a = kLast $ kNext a

getKmp :: Eq a => [a] -> KmpState a
getKmp [] = KEND
getKmp y@[x] = KS x y KEND
getKmp z@(x:y:xs) = KS x z (KM y (tail z) self (kmp' xs self))
  where
    self = getKmp z

    kmp' [] _ = KEND
    kmp' t@(r:rs) prevFail = KM r t curFail (kmp' rs curFail)
      where
        curFail = tryMatch prevFail

        tryMatch st
          | kMatch r st = kNext st
          | u@KS{} <- st = u
          | u@KM{} <- st = tryMatch $ kFail u
          | KEND <- st = error "Try to match end of KMP state"

data Count = C {c0 :: Int32, c1 :: Int32}

getCount :: String -> Count
getCount = L.foldl' inc (C 0 0)
  where
    inc p@(C r0 r1) c = if c == '0' then p{c0 = r0 + 1} else p{c1 = r1 + 1}

toString :: Count -> String
toString (C x y) = replicate (fromIntegral x) '0'
  ++ replicate (fromIntegral y) '1'

solve :: String -> String -> String
solve s t
  | [] <- t = s
  | cs0 < ct0 || cs1 < ct1 = s
  | otherwise = t
      ++ mconcat (replicate numOcc lastSuffix)
      ++ toString crest
  where
    tKmp = getKmp t
    lastSuffix = kGetSuffix $ kFail $ kLast tKmp
    (C ct0 ct1) = getCount t
    (C cs0 cs1) = getCount s
    (C cts0 cts1) = getCount lastSuffix
    numOcc = maybeMin (f cs0 ct0 cts0) (f cs1 ct1 cts1)
    crest = C
      (cs0 - ct0 - cts0 * fromIntegral numOcc)
      (cs1 - ct1 - cts1 * fromIntegral numOcc)
    f cs ct cts = fmap fromIntegral $
      if cts == 0 then Nothing else Just $ (cs - ct) `div` cts

    maybeMin Nothing (Just x) = x
    maybeMin (Just x) Nothing = x
    maybeMin (Just x) (Just y) = min x y

stripWindowsLB :: BS.ByteString -> BS.ByteString
stripWindowsLB a = if BS.isSuffixOf (BS.pack "\r") a
  then fromJust $ BS.stripSuffix (BS.pack "\r") a
  else a

type LineReader a = State [BS.ByteString] a

currentLine :: LineReader BS.ByteString
currentLine = do
  ls <- get
  let (x, xs) = case ls of
        [] -> error "No remain lines."
        l -> (head l, tail l)
  put xs
  return x

restLines :: LineReader [BS.ByteString]
restLines = do
  xs <- get
  put []
  return xs

runLineReader :: LineReader a -> [BS.ByteString] -> (a, [BS.ByteString])
runLineReader reader ls = runState reader (map stripWindowsLB ls)

main :: IO ()
main = do
  ls <- readLines
  let ((sl1, sl2), _) = flip runLineReader ls $ do
        rls <- restLines
        case rls of
          [l1, l2] -> return (BS.unpack l1, BS.unpack l2)
          _ -> error ""
  putStrLn $ solve sl1 sl2

module Main where

import Control.Applicative
import Control.Monad.State
import Data.Int
import Data.Maybe
import Data.Semigroup

import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as L

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

data KmpState a =
  KS a [a] (KmpState a)
  | KM a [a] (KmpState a) (KmpState a)
  | KEND

kMatch :: Eq a => a -> KmpState a -> Bool
kMatch _ KEND = False
kMatch x (KM y _ _ _) = x == y
kMatch x (KS y _ _ ) = x == y

kNext :: KmpState a -> KmpState a
kNext KEND = error "Already the end of KMP state."
kNext (KS _ _ n) = n
kNext (KM _ _ _ n) = n

kFail :: KmpState a -> KmpState a
kFail KEND = error "Already the end of KMP state."
kFail (KM _ _ f _) = f
kFail s@KS{} = s

kFailToList :: (a -> b) -> KmpState a -> [b]
kFailToList _ KEND = []
kFailToList f (KS a _ n) = f a : kFailToList f n
kFailToList f (KM _ _ p n) = f (e p) : kFailToList f n
  where
    e KEND = error "Impossible"
    e (KS k _ _) = k
    e (KM k _ _ _) = k

kGetSuffix :: KmpState a -> [a]
kGetSuffix KEND = []
kGetSuffix (KS _ as _) = as
kGetSuffix (KM _ as _ _) = as

kLast :: KmpState a -> KmpState a
kLast KEND = KEND
kLast a@(KS _ _ KEND) = a
kLast a@(KM _ _ _ KEND) = a
kLast a = kLast $ kNext a

getKmp :: Eq a => [a] -> KmpState a
getKmp [] = KEND
getKmp y@[x] = KS x y KEND
getKmp z@(x:xs) = KS x z (kmp' xs self)
  where
    self = getKmp z

    kmp' [] _ = KEND
    kmp' t@(r:rs) curFail = KM r t curFail (kmp' rs nextFail)
      where
        nextFail = tryMatch curFail

        tryMatch st
          | kMatch r st = kNext st
          | u@KS{} <- st = u
          | u@KM{} <- st = tryMatch $ kFail u
          | KEND <- st = error "Try to match end of KMP state"

stripWindowsLB :: BS.ByteString -> BS.ByteString
stripWindowsLB a = if BS.isSuffixOf (BS.pack "\r") a
  then fromJust $ BS.stripSuffix (BS.pack "\r") a
  else a

type LineReader a = State [BS.ByteString] a

currentLine :: LineReader BS.ByteString
currentLine = do
  ls <- get
  let (x, xs) = case ls of
        [] -> error "No remain lines."
        l -> (head l, tail l)
  put xs
  return x

restLines :: LineReader [BS.ByteString]
restLines = do
  xs <- get
  put []
  return xs

runLineReader :: LineReader a -> [BS.ByteString] -> (a, [BS.ByteString])
runLineReader reader ls = runState reader (map stripWindowsLB ls)

data Count = C {c0 :: Int32, c1 :: Int32}

getCount :: String -> Count
getCount = L.foldl' inc (C 0 0)
  where
    inc p@(C r0 r1) c = if c == '0' then p{c0 = r0 + 1} else p{c1 = r1 + 1}

toString :: Count -> String
toString (C x y) = replicate (fromIntegral x) '0'
  ++ replicate (fromIntegral y) '1'

solve :: String -> String -> String
solve s t
  | [] <- t = s
  | cs0 < ct0 || cs1 < ct1 = s
  | otherwise = t
      ++ mconcat (replicate numOcc lastSuffix)
      ++ toString crest
  where
    tKmp = getKmp t
    lastSuffix = case kGetSuffix $ kNext $ kFail $ kLast tKmp of
      [] -> t
      x -> x
    (C ct0 ct1) = getCount t
    (C cs0 cs1) = getCount s
    (C cts0 cts1) = getCount lastSuffix
    numOcc = maybeMin (f cs0 ct0 cts0) (f cs1 ct1 cts1)
    crest = C
      (cs0 - ct0 - cts0 * fromIntegral numOcc)
      (cs1 - ct1 - cts1 * fromIntegral numOcc)
    f cs ct cts = fmap fromIntegral $
      if cts == 0 then Nothing else Just $ (cs - ct) `div` cts

    maybeMin Nothing (Just x) = x
    maybeMin (Just x) Nothing = x
    maybeMin (Just x) (Just y) = min x y

main :: IO ()
main = do
  ls <- readLines
  let ((sl1, sl2), _) = flip runLineReader ls $ do
        rls <- restLines
        case rls of
          [l1, l2] -> return (BS.unpack l1, BS.unpack l2)
          _ -> error ""
  let a = kFailToList id $ getKmp $ zipWith Arg sl2 [1..] :: [Arg Char Int]
  -- print $ map (\(Arg _ b) -> b) a
  putStrLn $ solve sl1 sl2


The History of Magic is perhaps the most boring subject in the Hogwarts school of Witchcraft and Wizardry. Harry Potter is usually asleep during history lessons, and his magical quill writes the lectures for him. Professor Binns, the history of magic teacher, lectures in such a boring and monotonous voice, that he has a soporific effect even on the quill. That's why the quill often makes mistakes, especially in dates.So, at the end of the semester Professor Binns decided to collect the students' parchments with notes and check them. Ron Weasley is in a panic: Harry's notes may contain errors, but at least he has some notes, whereas Ron does not have any. Ronald also has been sleeping during the lectures and his quill had been eaten by his rat Scabbers. Hermione Granger refused to give Ron her notes, because, in her opinion, everyone should learn on their own. Therefore, Ron has no choice but to copy Harry's notes.Due to the quill's errors Harry's dates are absolutely confused: the years of goblin rebellions and other important events for the wizarding world do not follow in order, and sometimes even dates from the future occur. Now Ron wants to change some of the digits while he copies the notes so that the dates were in the chronological (i.e. non-decreasing) order and so that the notes did not have any dates strictly later than 2011, or strictly before than 1000. To make the resulting sequence as close as possible to the one dictated by Professor Binns, Ron will change no more than one digit in each date into other digit. Help him do it.

The first input line contains an integer n (1 ≤ n ≤ 1000). It represents the number of dates in Harry's notes. Next n lines contain the actual dates y1, y2, ..., yn, each line contains a date. Each date is a four-digit integer (1000 ≤ yi ≤ 9999).

Print n numbers z1, z2, ..., zn (1000 ≤ zi ≤ 2011). They are Ron's resulting dates. Print each number on a single line. Numbers zi must form the non-decreasing sequence. Each number zi should differ from the corresponding date yi in no more than one digit. It is not allowed to change the first digit of a number into 0. If there are several possible solutions, print any of them. If there's no solution, print "No solution" (without the quotes).

module Main where

import Data.Maybe

convert :: String -> String -> Maybe String
convert prev y = if acc == [] then Nothing else Just (minimum acc) where
    acc = filter (>= prev) all
    all = concatMap vars [0 .. 3]
    vars n = map (\c -> take n y ++ c:(drop (n+1) y)) ['0' .. '9']

build :: String -> [String] -> [String]
build _ [] = []
build prev (y:ys) = conv : (build conv ys)
    where conv = fromMaybe "9999" $ convert prev y

solve :: [String] -> Maybe [String]
solve years = if last ans <= "2011" then Just ans else Nothing where
    ans = build "1000" years

main = do
    sn <- getLine
    sYear <- getContents
    let lYear = words sYear
    let ans = solve lYear
    putStrLn $ if ans == Nothing
        then "No solution"
        else unlines (fromMaybe [] ans)

main = interact $ unlines . solve . (map (read :: String -> Int)) . tail . lines
solve xs = if elem 0 ans then ["No solution"] else map show ans
  where ans = solve0 (1000:xs)
solve0 [x] = []
solve0 (x:y:xs) = if null ys then [0] else y':(solve0 (y':xs))
  where ys = filter (check y) [x..2011]
        y' = head ys
check x y = 2>(length $ filter (==False) $ zipWith (==) (show x) (show y))


Sengoku still remembers the mysterious "colourful meteoroids" she discovered with Lala-chan when they were little. In particular, one of the nights impressed her deeply, giving her the illusion that all her fancies would be realized.On that night, Sengoku constructed a permutation p1, p2, ..., pn of integers from 1 to n inclusive, with each integer representing a colour, wishing for the colours to see in the coming meteor outburst. Two incredible outbursts then arrived, each with n meteorids, colours of which being integer sequences a1, a2, ..., an and b1, b2, ..., bn respectively. Meteoroids' colours were also between 1 and n inclusive, and the two sequences were not identical, that is, at least one i (1 ≤ i ≤ n) exists, such that ai ≠ bi holds.Well, she almost had it all — each of the sequences a and b matched exactly n - 1 elements in Sengoku's permutation. In other words, there is exactly one i (1 ≤ i ≤ n) such that ai ≠ pi, and exactly one j (1 ≤ j ≤ n) such that bj ≠ pj.For now, Sengoku is able to recover the actual colour sequences a and b through astronomical records, but her wishes have been long forgotten. You are to reconstruct any possible permutation Sengoku could have had on that night.

The first line of input contains a positive integer n (2 ≤ n ≤ 1 000) — the length of Sengoku's permutation, being the length of both meteor outbursts at the same time. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ n) — the sequence of colours in the first meteor outburst. The third line contains n space-separated integers b1, b2, ..., bn (1 ≤ bi ≤ n) — the sequence of colours in the second meteor outburst. At least one i (1 ≤ i ≤ n) exists, such that ai ≠ bi holds.

Output n space-separated integers p1, p2, ..., pn, denoting a possible permutation Sengoku could have had. If there are more than one possible answer, output any one of them. Input guarantees that such permutation exists.

NoteIn the first sample, both 1, 2, 5, 4, 3 and 1, 2, 3, 4, 5 are acceptable outputs.In the second sample, 5, 4, 2, 3, 1 is the only permutation to satisfy the constraints.

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

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n as bs = snd $ mapAccumL (\k (a, b) -> if a /= b && a == k && (o || b == m) then (0, m) else (k, a)) k $ zip as bs
  where
    zs = zip as bs
    m = head $ [1..n] \\ as
    k = head $ fromMaybe undefined $ find (\g -> case g of { [_, _] -> True; _ -> False }) $ group $ sort as
    o = case filter (uncurry (/=)) zs of { [_] -> True; _ -> False }

main = do
  n <- readInt <$> B.getLine
  as <- readInts <$> B.getLine
  bs <- readInts <$> B.getLine
  putStr $ unwords $ map show $ solve n as bs

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

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n as bs = snd $ mapAccumL (\k (a, b) -> if a /= b && a == k && (o || b == m) then (0, m) else (k, a)) (head $ fromMaybe undefined $ find (\g -> case g of { [_, _] -> True; _ -> False }) $ group $ sort as) zs
  where
    zs = zip as bs
    o = case filter (uncurry (/=)) zs of { [_] -> True; _ -> False }
    m = head $ [1..n] \\ as

main = do
  n <- readInt <$> B.getLine
  as <- readInts <$> B.getLine
  bs <- readInts <$> B.getLine
  putStr $ unwords $ map show $ solve n as bs

import Data.List

doit :: [String] -> [String] -> [String]
doit [] _ = []
doit ("0":xs) (n:ns) = n : doit xs ns
doit (x:xs) ns = x : doit xs ns

valid :: [String] -> [String] -> Bool
valid ans a = (==) 1 . length . filter (uncurry (/=)) . zip ans $ a

main = do
  n <- readLn
  a <- getLine >>= return . words
  b <- getLine >>= return . words
  let numbers = map show $ [1..n] \\ (map (read . fst) . filter (uncurry (==)) . zip a $ b)
  let tmp = map (\(x,y) -> if x == y then x else "0") . zip a $ b
  let ans1 = doit tmp numbers
  let ans2 = doit tmp . reverse $ numbers
  let ans = if valid ans1 a && valid ans1 b then ans1 else ans2
  putStrLn . unwords $ ans

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE TypeOperators #-}

module Main where

import Data.List
-- import Data.Char
import Data.Maybe
-- import Control.Applicative
import Control.Monad
import System.IO

main :: IO ()
main = do
  -- handle <- openFile "input.txt" ReadMode
  -- contents <- hGetContents handle
  contents <- getContents
  let linesOfFile = lines contents
      t = read $ (linesOfFile !! 0) :: Int
      a = map (\x -> read x :: Int) . words $ (linesOfFile !! 1)
      b = map (\x -> read x :: Int) . words $ (linesOfFile !! 2)
      res = solve a b
    in
    putStrLn $ unwords $ map show $  res

  -- ii <- getLine
  -- aa <- getLine
  -- bb <- getLine
  -- let
  --   nn = map (\x -> read x :: Int) $ words $ ii
  --   n = nn !! 0
  --   k = nn !! 1
  --   a = map (\x -> read x :: Int) $ words $ aa
  --   b = map (\x -> read x :: Int) $ words $ bb

  --   res = solve a b
  --  in
  --   putStrLn res

findDiff _ [] _ = []
findDiff _ _ [] = []
findDiff i (x:xs) (y:ys) =
  if x /= y then i:findDiff (i + 1) xs ys else findDiff (i + 1) xs ys

replaceZero _ [] a = a
replaceZero _ _ [] = []
replaceZero i rr@(r:rs) (a:as) =
  if i == r then 0:replaceZero (i + 1) rs as
  else a:replaceZero (i + 1) rr as

replaceList _ [] = []
replaceList [] a = a
replaceList rr@(r:rs) (a:as) =
  if a == 0 then r:replaceList rs as
  else a:replaceList rr as

solve a b =
  let
    dff = findDiff 0 a b
    aa = replaceZero 0 dff a
    k = [1..length a] \\ aa
    r = replaceList k aa
    r1 = replaceList ([a!!(dff!!0)] ++ [b!!(dff!!1)]) aa
    r2 = replaceList ([b!!(dff!!0)] ++ [a!!(dff!!1)]) aa
    l1 = nub r1

    res = if length dff == 1 then r else
            if length l1 == length a then r1 else r2
  in
    res

import qualified Data.Set as S

glueWhereZero :: [Int] -> [Int] -> [Int]
glueWhereZero [] b = b
glueWhereZero (x:a) (y:b)
  | y == 0 = x : (glueWhereZero a b)
  | otherwise = y : (glueWhereZero (x:a) b)

main = do
  getLine
  as <- getLine
  bs <- getLine
  let a = map (\x -> read x :: Int) $ words as
  let b = map (\x -> read x :: Int) $ words bs
  let c = map (\x -> if uncurry (==) x then fst x else 0) $ zip a b
  let r = S.toList $ S.difference (S.fromList [1..(length a)]) (S.fromList $ filter (/=0) c)
  let p1 = glueWhereZero r c
  let p2 = glueWhereZero (reverse r) c
  let tmp = length . (filter (uncurry (/=))) . (zip p1)
  putStrLn $ unwords $ map show $ if (tmp a) == 1 && (tmp b) == 1 then p1 else p2

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

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve n as bs = snd $ mapAccumL (\k (a, b) -> if a /= b && a == k then (0, m) else (k, a)) k $ zip as bs
  where
    m = head $ [1..n] \\ as
    k = head $ fromMaybe undefined $ find (\g -> case g of { [_, _] -> True; _ -> False }) $ group $ sort as

main = do
  n <- readInt <$> B.getLine
  as <- readInts <$> B.getLine
  bs <- readInts <$> B.getLine
  putStr $ unwords $ map show $ solve n as bs

import Data.List

doit :: [String] -> [String] -> [String]
doit [] _ = []
doit ("0":xs) (n:ns) = n : doit xs ns
doit (x:xs) ns = x : doit xs ns

main = do
  n <- readLn
  a <- getLine >>= return . words
  b <- getLine >>= return . words
  let numbers = map show $ [1..n] \\ (map (read . fst) . filter (uncurry (==)) . zip a $ b)
  let tmp = map (\(x,y) -> if x == y then x else "0") . zip a $ b
  putStrLn . unwords $ doit tmp numbers

main = do
  getLine
  a <- getLine >>= return . words
  b <- getLine >>= return . words
  let tmp = filter (uncurry (/=) . fst) . zip (zip a b) $ [0..]
  let numbers = fst . head $ tmp
  let indices = map snd $ tmp
  putStr . unwords . take (head indices) $ a
  putStr $ " " ++ fst numbers ++ " "
  putStr . unwords . take ((head . tail $ indices) - (head indices) - 1) . drop (head indices + 1) $ a
  putStr $ " " ++ snd numbers ++ " "
  putStrLn . unwords . drop ((head . tail $ indices) + 1) $ a

import qualified Data.Set as S

glueWhereZero :: [Int] -> [Int] -> [Int]
glueWhereZero [] b = b
glueWhereZero (x:a) (y:b)
  | y == 0 = x : (glueWhereZero a b)
  | otherwise = y : (glueWhereZero (x:a) b)

main = do
  getLine
  as <- getLine
  bs <- getLine
  let a = map (\x -> read x :: Int) $ words as
  let b = map (\x -> read x :: Int) $ words bs
  let c = map (\x -> if uncurry (==) x then fst x else 0) $ zip a b
  let r = S.toList $ S.difference (S.fromList [1..(length a)]) (S.fromList $ filter (/=0) c)
  let p1 = glueWhereZero r c
  let p2 = glueWhereZero (reverse r) c
  putStrLn $ unwords $ map show $ if (length $ filter (uncurry (/=)) $ zip a p1) == 1 && (length $ filter (uncurry (/=)) $ zip a p2) == 1 then
    p1
    else
      p2


Circular land is an $$$2n \times 2n$$$ grid. Rows of this grid are numbered by integers from $$$1$$$ to $$$2n$$$ from top to bottom and columns of this grid are numbered by integers from $$$1$$$ to $$$2n$$$ from left to right. The cell $$$(x, y)$$$ is the cell on the intersection of row $$$x$$$ and column $$$y$$$ for $$$1 \leq x \leq 2n$$$ and $$$1 \leq y \leq 2n$$$.There are $$$n^2$$$ of your friends in the top left corner of the grid. That is, in each cell $$$(x, y)$$$ with $$$1 \leq x, y \leq n$$$ there is exactly one friend. Some of the other cells are covered with snow.Your friends want to get to the bottom right corner of the grid. For this in each cell $$$(x, y)$$$ with $$$n+1 \leq x, y \leq 2n$$$ there should be exactly one friend. It doesn't matter in what cell each of friends will be.You have decided to help your friends to get to the bottom right corner of the grid.For this, you can give instructions of the following types:   You select a row $$$x$$$. All friends in this row should move to the next cell in this row. That is, friend from the cell $$$(x, y)$$$ with $$$1 \leq y < 2n$$$ will move to the cell $$$(x, y + 1)$$$ and friend from the cell $$$(x, 2n)$$$ will move to the cell $$$(x, 1)$$$.  You select a row $$$x$$$. All friends in this row should move to the previous cell in this row. That is, friend from the cell $$$(x, y)$$$ with $$$1 < y \leq 2n$$$ will move to the cell $$$(x, y - 1)$$$ and friend from the cell $$$(x, 1)$$$ will move to the cell $$$(x, 2n)$$$.  You select a column $$$y$$$. All friends in this column should move to the next cell in this column. That is, friend from the cell $$$(x, y)$$$ with $$$1 \leq x < 2n$$$ will move to the cell $$$(x + 1, y)$$$ and friend from the cell $$$(2n, y)$$$ will move to the cell $$$(1, y)$$$.  You select a column $$$y$$$. All friends in this column should move to the previous cell in this column. That is, friend from the cell $$$(x, y)$$$ with $$$1 < x \leq 2n$$$ will move to the cell $$$(x - 1, y)$$$ and friend from the cell $$$(1, y)$$$ will move to the cell $$$(2n, y)$$$. Note how friends on the grid border behave in these instructions.  Example of applying the third operation to the second column. Here, colorful circles denote your friends and blue cells are covered with snow. You can give such instructions any number of times. You can give instructions of different types. If after any instruction one of your friends is in the cell covered with snow he becomes ill.In order to save your friends you can remove snow from some cells before giving the first instruction:   You can select the cell $$$(x, y)$$$ that is covered with snow now and remove snow from this cell for $$$c_{x, y}$$$ coins. You can do this operation any number of times.You want to spend the minimal number of coins and give some instructions to your friends. After this, all your friends should be in the bottom right corner of the grid and none of them should be ill.Please, find how many coins you will spend.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains the single integer $$$n$$$ ($$$1 \leq n \leq 250$$$). Each of the next $$$2n$$$ lines contains $$$2n$$$ integers $$$c_{i, 1}, c_{i, 2}, \ldots, c_{i, 2n}$$$ ($$$0 \leq c_{i, j} \leq 10^9$$$) — costs of removing snow from cells. If $$$c_{i, j} = 0$$$ for some $$$i, j$$$ than there is no snow in cell $$$(i, j)$$$. Otherwise, cell $$$(i, j)$$$ is covered with snow. It is guaranteed that $$$c_{i, j} = 0$$$ for $$$1 \leq i, j \leq n$$$. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$250$$$.

For each test case output one integer — the minimal number of coins you should spend.

NoteIn the first test case you can remove snow from the cells $$$(2, 1)$$$ and $$$(2, 2)$$$ for $$$100$$$ coins. Then you can give instructions   All friends in the first collum should move to the previous cell. After this, your friend will be in the cell $$$(2, 1)$$$.  All friends in the second row should move to the next cell. After this, your friend will be in the cell $$$(2, 2)$$$. In the second test case you can remove all snow from the columns $$$3$$$ and $$$4$$$ for $$$22$$$ coins. Then you can give instructions   All friends in the first row should move to the next cell.  All friends in the first row should move to the next cell.  All friends in the second row should move to the next cell.  All friends in the second row should move to the next cell.  All friends in the third column should move to the next cell.  All friends in the third column should move to the next cell.  All friends in the fourth column should move to the next cell.  All friends in the fourth column should move to the next cell. It can be shown that none of the friends will become ill and that it is impossible to spend less coins.

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

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

-- stupid solution is way easier to guess than prove
mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    cli <- getInts (4*n*n)
    let
      c :: UArray (Int, Int) Int
      c = listArray ((1, 1), (2*n, 2*n)) cli
      opts = map (c !)
        $ liftM2 (,) [1, n] [n+1, 2*n] ++ liftM2 (,) [n+1, 2*n] [1, n]
      ans = foldl' (+) (foldl' min maxBound opts)
        $ [c ! (i, j) | i <- [n+1 .. 2*n], j <- [n+1 .. 2*n]]
    pure $ putInts [ans]

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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


You are given a string $$$s$$$, consisting of $$$n$$$ lowercase Latin letters.A substring of string $$$s$$$ is a continuous segment of letters from $$$s$$$. For example, "defor" is a substring of "codeforces" and "fors" is not. The length of the substring is the number of letters in it.Let's call some string of length $$$n$$$ diverse if and only if there is no letter to appear strictly more than $$$\frac n 2$$$ times. For example, strings "abc" and "iltlml" are diverse and strings "aab" and "zz" are not.Your task is to find any diverse substring of string $$$s$$$ or report that there is none. Note that it is not required to maximize or minimize the length of the resulting substring.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the length of string $$$s$$$. The second line is the string $$$s$$$, consisting of exactly $$$n$$$ lowercase Latin letters.

Print "NO" if there is no diverse substring in the string $$$s$$$. Otherwise the first line should contain "YES". The second line should contain any diverse substring of string $$$s$$$.

NoteThe first example has lots of correct answers. Please, restrain yourself from asking if some specific answer is correct for some specific test or not, these questions always lead to "No comments" answer.

diverse [] n = "NO"
diverse [a] n = if n == 1  then "YES\n"++[a] else "NO"
diverse (a:b:cs) n = if a/=b then "YES\n"++[a,b] else diverse (b:cs) n

main = do
  n <- getLine >>= return . (read :: String -> Int)
  s <- getLine
  putStrLn $ if length s == 1 then "NO" else diverse s n

f::String->String
f []=""
f (x:[])=""
f (x:y:xs)
   |x/=y=(x:y:[])
   |otherwise=f (y:xs)

main = do
       e<-getLine
       e2<-getLine
       let a=f e2
       putStrLn $ if a=="" then "NO" else "YES\n"++a

diverseSubs :: [Char] -> [Char]
diverseSubs (a:[]) = ""
diverseSubs (a:b:rest) = if a /= b
                           then [a,b]
                           else diverseSubs (b:rest)

main :: IO ()
main = do
  n <- getLine
  line <- getLine
  let subline = diverseSubs line
  if subline == ""
    then putStrLn "NO"
    else mapM_ putStrLn ["Yes", subline]

import Data.List
main = do
  getLine
  w <- getLine
  case find f (tails w) of
    Nothing -> putStrLn "NO"
    Just (a:b:_) -> putStrLn "YES" >> putStrLn [a,b]
f (a:b:_) = a /= b
f _ = False

diverse [] n = "NO"
diverse [a] n = if n == 1  then "YES\n"++[a] else "NO"
diverse (a:b:cs) n = if a/=b then "YES\n"++[a,b] else diverse (b:cs) n

main = do
  n <- getLine >>= return . (read :: String -> Int)
  s <- getLine
  putStrLn $ diverse s n

import qualified Data.Set as S
import Data.List
import Control.Arrow
main = do
  l <- readLn
  w <- getLine
  let m = S.fromList $ map (length &&& head) $ group $ sort w
      m' = go l m
  if S.null m' then putStrLn "NO" else do
    putStrLn "YES"
    putStrLn $ intersect' w $ concat (map (uncurry replicate) (S.elems m'))
go l m | Just ((n,c),m') <- S.maxView m, 2*n > l =
           go (l-1) $ if n == 1 then m' else S.insert (n-1,c) m'
       | otherwise = m
intersect' (a:as) bs | a `elem` bs = a : intersect' as (delete a bs)
                     | otherwise = intersect' as bs
intersect' [] _ = []

import qualified Data.Set as S
import Data.List
import Control.Arrow
main = do
  l <- readLn
  w <- getLine
  let m = S.fromList $ map (length &&& head) $ group $ sort w
      m' = go l m
  if S.null m' then putStrLn "NO" else do
    putStrLn "YES"
    putStrLn $ intersect w $ concat (map (uncurry replicate) (S.elems m'))
go l m | Just ((n,c),m') <- S.maxView m, 2*n > l =
           go (l-1) $ if n == 1 then m' else S.insert (n-1,c) m'
       | otherwise = m


ZS the Coder is playing a game. There is a number displayed on the screen and there are two buttons, ' + ' (plus) and '' (square root). Initially, the number 2 is displayed on the screen. There are n + 1 levels in the game and ZS the Coder start at the level 1.When ZS the Coder is at level k, he can :  Press the ' + ' button. This increases the number on the screen by exactly k. So, if the number on the screen was x, it becomes x + k. Press the '' button. Let the number on the screen be x. After pressing this button, the number becomes . After that, ZS the Coder levels up, so his current level becomes k + 1. This button can only be pressed when x is a perfect square, i.e. x = m2 for some positive integer m. Additionally, after each move, if ZS the Coder is at level k, and the number on the screen is m, then m must be a multiple of k. Note that this condition is only checked after performing the press. For example, if ZS the Coder is at level 4 and current number is 100, he presses the '' button and the number turns into 10. Note that at this moment, 10 is not divisible by 4, but this press is still valid, because after it, ZS the Coder is at level 5, and 10 is divisible by 5.ZS the Coder needs your help in beating the game — he wants to reach level n + 1. In other words, he needs to press the '' button n times. Help him determine the number of times he should press the ' + ' button before pressing the '' button at each level. Please note that ZS the Coder wants to find just any sequence of presses allowing him to reach level n + 1, but not necessarily a sequence minimizing the number of presses.

The first and only line of the input contains a single integer n (1 ≤ n ≤ 100 000), denoting that ZS the Coder wants to reach level n + 1.

Print n non-negative integers, one per line. i-th of them should be equal to the number of times that ZS the Coder needs to press the ' + ' button before pressing the '' button at level i.  Each number in the output should not exceed 1018. However, the number on the screen can be greater than 1018. It is guaranteed that at least one solution exists. If there are multiple solutions, print any of them.

NoteIn the first sample case:On the first level, ZS the Coder pressed the ' + ' button 14 times (and the number on screen is initially 2), so the number became 2 + 14·1 = 16. Then, ZS the Coder pressed the '' button, and the number became . After that, on the second level, ZS pressed the ' + ' button 16 times, so the number becomes 4 + 16·2 = 36. Then, ZS pressed the '' button, levelling up and changing the number into .After that, on the third level, ZS pressed the ' + ' button 46 times, so the number becomes 6 + 46·3 = 144. Then, ZS pressed the '' button, levelling up and changing the number into . Note that 12 is indeed divisible by 4, so ZS the Coder can reach level 4.Also, note that pressing the ' + ' button 10 times on the third level before levelling up does not work, because the number becomes 6 + 10·3 = 36, and when the '' button is pressed, the number becomes  and ZS the Coder is at Level 4. However, 6 is not divisible by 4 now, so this is not a valid solution.In the second sample case:On the first level, ZS the Coder pressed the ' + ' button 999999999999999998 times (and the number on screen is initially 2), so the number became 2 + 999999999999999998·1 = 1018. Then, ZS the Coder pressed the '' button, and the number became . After that, on the second level, ZS pressed the ' + ' button 44500000000 times, so the number becomes 109 + 44500000000·2 = 9·1010. Then, ZS pressed the '' button, levelling up and changing the number into . Note that 300000 is a multiple of 3, so ZS the Coder can reach level 3.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
main = readLn >>= putStr.unlines.map show.solve

solve :: Int -> [Integer]
solve n = take n $ go 1 2
  where
    go !k !x = a : go (k+1) (k * (k+1))
      where
        a :: Integer
        a = k*(k+1)*(k+1)-quot x k

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Monad
import Data.Array

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Integer]
 where fn x = let Just (y,_) = B.readInteger x in y

main = do
    a <- readLn :: IO Integer
    mapM_ print $ go 2 [1..a]

go _ [] = []
go st (l:ls) =
    let prev = st `div` l
        tgt = l*(l+1)*(l+1)
        sq = truncate . sqrt . fromIntegral
    in tgt-prev: go (sq (tgt*l)) ls

{--
import Control.Monad( replicateM_, replicateM, forever)
import Control.Monad.Trans.State( StateT, evalStateT, execStateT, runStateT
			    , get, put)
import Control.Monad.Trans.Writer( WriterT, tell, execWriterT)
import Control.Monad.Trans( lift)
type Level = Int
type State_T = StateT Level (WriterT [Integer] IO) Integer
type Writer_T = WriterT [Integer] IO [Integer]
main = do
    n <- readLn
    let process::Integer -> State_T
	process v = do
	    lv <- get
	    let nextLv = succ lv
		candidate = map fun [1..]
		  where
		    fun l = (l, (nume l) `divMod` toInteger lv)
		    nume l = l^2 * (toInteger nextLv)^2 - v
		(k,resultL) = repack . head $ dropWhile p candidate
		  where
		    repack (l,(d,m)) = (d,l)
		    p (_,(_,m)) = m/=0
	    put nextLv
	    lift $ tell [k]
	    return $ toInteger nextLv * resultL
    let writ::Writer_T
	writ = (`evalStateT` 1) $
		replicateM n . process $ 2
    mapM_ print =<< execWriterT writ
--}
main = do
    n <- readLn
    let l 0 = [2]::[Integer]
	l n = [n,2*n..]
	k n = head $ filter (0<) [m^2 * n' * (n'+1)^2 - l   |
				    m <- [1..]::[Integer]   ,
				    l <- l (n-1)	    ]
	  where n' = toInteger n
    mapM_ (print . k) [1..n]

main = readLn >>= putStr . unlines . map show . solve
solve n = 2 : map (\n -> n * (n + 1)^2 - n + 1) [2 .. n]

main = readLn >>= mapM_ print . solve
solve n = 2 : map (\n -> n * (n + 1)^2 - n + 1) [2 .. n]

import Control.Monad

main :: IO ()
main = do
        x <- readLn :: IO Int
        let ret = take x $ 2:map (\i -> i * (i+1)*(i+1) - (i-1)) [2..] :: [Integer]
        forM_ ret print

main = readLn >>= putStr.unlines.map show.solve

solve :: Integer -> [Integer]
solve n = map f [1..n]
  where
    f 1 = 2
    f x = (x+1)^2 - x


Vasya is sitting on an extremely boring math class. To have fun, he took a piece of paper and wrote out n numbers on a single line. After that, Vasya began to write out different ways to put pluses ("+") in the line between certain digits in the line so that the result was a correct arithmetic expression; formally, no two pluses in such a partition can stand together (between any two adjacent pluses there must be at least one digit), and no plus can stand at the beginning or the end of a line. For example, in the string 100500, ways 100500 (add no pluses), 1+00+500 or 10050+0 are correct, and ways 100++500, +1+0+0+5+0+0 or 100500+ are incorrect.The lesson was long, and Vasya has written all the correct ways to place exactly k pluses in a string of digits. At this point, he got caught having fun by a teacher and he was given the task to calculate the sum of all the resulting arithmetic expressions by the end of the lesson (when calculating the value of an expression the leading zeros should be ignored). As the answer can be large, Vasya is allowed to get only its remainder modulo 109 + 7. Help him!

The first line contains two integers, n and k (0 ≤ k < n ≤ 105). The second line contains a string consisting of n digits.

Print the answer to the problem modulo 109 + 7.

NoteIn the first sample the result equals (1 + 08) + (10 + 8) = 27.In the second sample the result equals 1 + 0 + 8 = 9.

{-# LANGUAGE BangPatterns #-}
import Data.Char (ord)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)
-- import Debug.Trace (traceShow)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int64 -> Int64 -> ByteString -> Int64
solve !n !k = foldl' (+:) 0 . zipWith (*:) b . fmap ord' . C.unpack . C.reverse
    where
    m = 1000000007 :: Int64
    (+:), (*:), (/:) :: Int64 -> Int64 -> Int64
    (+:) !i !j = (i + j) `mod` m
    (*:) !i !j = (i * j) `mod` m
    (/:) !i !j
        | i `mod` j == 0 = i `div` j
        | otherwise      = i *: j'
        where j' = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' j m

    a = scanl go first [1..n-1]
        where
        go !acc !i = acc *: (n - i - k) /: (n - i)
        -- n - 1 choose k
        !first = prod [k + 1..n - 1] /: prod [1..n - k - 1] :: Int64
            where prod = foldl' (*:) 1

    b = scanl1 (+:) . zipWith (*:) a $ (1: iterate (*: 10) 9)
    ord' = fromIntegral . (+ (-48)) . ord

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

main = do
    [n, k] <- parse <$> B.getLine
    line <- B.getLine
    print $ solve (fromIntegral n) (fromIntegral k) $ C.init line

{-# LANGUAGE BangPatterns #-}
import Data.Char (ord)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)
-- import Debug.Trace (traceShow)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int64 -> Int64 -> ByteString -> Int64
solve !n !k = foldl' (+:) 0 . zipWith (*:) b . fmap ord' . C.unpack . C.reverse
    where
    m = 1000000007 :: Int64
    (+:), (*:), (/:) :: Int64 -> Int64 -> Int64
    (+:) !i !j = (i + j) `mod` m
    (*:) !i !j = (i * j) `mod` m
    (/:) !i !j
        | i `mod` j == 0 = i `div` j
        | otherwise      = i *: j'
        where j' = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' j m

    a = scanl go first [1..n-1]
        where
        go !acc !i = acc *: (n - i - k) /: (n - i)
        -- n - 1 choose k
        !first = prod [k + 1..n - 1] /: prod [1..n - k - 1] :: Int64
            where prod = foldl' (*:) 1

    b = scanl1 (+:) . zipWith (*:) a $ (1: iterate (*: 10) 9)
    ord' = fromIntegral . (+ (-48)) . ord

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

main = do
    [n, k] <- parse <$> B.getLine
    line <- B.getLine
    print $ solve (fromIntegral n) (fromIntegral k) line


You are given an array $$$a$$$ consisting of $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$. Friends asked you to make the greatest common divisor (GCD) of all numbers in the array equal to $$$1$$$. In one operation, you can do the following: Select an arbitrary index in the array $$$1 \leq i \leq n$$$; Make $$$a_i = \gcd(a_i, i)$$$, where $$$\gcd(x, y)$$$ denotes the GCD of integers $$$x$$$ and $$$y$$$. The cost of such an operation is $$$n - i + 1$$$.You need to find the minimum total cost of operations we need to perform so that the GCD of the all array numbers becomes equal to $$$1$$$.

Each test consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 5\,000$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 20$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the elements of the array.

For each test case, output a single integer — the minimum total cost of operations that will need to be performed so that the GCD of all numbers in the array becomes equal to $$$1$$$. We can show that it's always possible to do so.

NoteIn the first test case, the GCD of the entire array is already equal to $$$1$$$, so there is no need to perform operations.In the second test case, select $$$i = 1$$$. After this operation, $$$a_1 = \gcd(2, 1) = 1$$$. The cost of this operation is $$$1$$$.In the third test case, you can select $$$i = 1$$$, after that the array $$$a$$$ will be equal to $$$[1, 4]$$$. The GCD of this array is $$$1$$$, and the total cost is $$$2$$$.In the fourth test case, you can select $$$i = 2$$$, after that the array $$$a$$$ will be equal to $$$[3, 2, 9]$$$. The GCD of this array is $$$1$$$, and the total cost is $$$2$$$.In the sixth test case, you can select $$$i = 4$$$ and $$$i = 5$$$, after that the array $$$a$$$ will be equal to $$$[120, 60, 80, 4, 5]$$$. The GCD of this array is $$$1$$$, and the total cost is $$$3$$$.

import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . unwords . map show

solve xs
    | g == 1 = 0
    | gcd g len == 1 = 1
    | gcd g (len - 1) == 1 = 2
    | otherwise = 3
    where g = foldl gcd 0 xs
          len = length xs

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    _ <- getInts
    xs <- getInts
    print $ solve xs

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

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

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

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

#else

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int
solve n as = answer
    where
        g = L.foldl1' gcd as
        answer
            | g == 1 = 0
            | (gcd g n) == 1 = 1
            | (gcd g (n - 1)) == 1 = 2
            | otherwise = 3

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


Luntik came out for a morning stroll and found an array $$$a$$$ of length $$$n$$$. He calculated the sum $$$s$$$ of the elements of the array ($$$s= \sum_{i=1}^{n} a_i$$$). Luntik calls a subsequence of the array $$$a$$$ nearly full if the sum of the numbers in that subsequence is equal to $$$s-1$$$.Luntik really wants to know the number of nearly full subsequences of the array $$$a$$$. But he needs to come home so he asks you to solve that problem!A sequence $$$x$$$ is a subsequence of a sequence $$$y$$$ if $$$x$$$ can be obtained from $$$y$$$ by deletion of several (possibly, zero or all) elements.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The next $$$2 \cdot t$$$ lines contain descriptions of test cases. The description of each test case consists of two lines. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 60$$$) — the length of the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — the elements of the array $$$a$$$.

For each test case print the number of nearly full subsequences of the array.

NoteIn the first test case, $$$s=1+2+3+4+5=15$$$, only $$$(2,3,4,5)$$$ is a nearly full subsequence among all subsequences, the sum in it is equal to $$$2+3+4+5=14=15-1$$$.In the second test case, there are no nearly full subsequences.In the third test case, $$$s=1+0=1$$$, the nearly full subsequences are $$$(0)$$$ and $$$()$$$ (the sum of an empty subsequence is $$$0$$$).

{-# OPTIONS -Wall #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad

main :: IO ()
main = do
    numTests <- readLn
    replicateM_ numTests $ do
        _ :: Int <- readLn
        as :: [Int] <- map read . words <$> getLine
        let numZeros = length . filter (== 0) $ as
        let numOnes = toInteger . length . filter (== 1) $ as
        let result = ((2 :: Integer) ^ numZeros) * numOnes
        print result