You have a statistic of price changes for one product represented as an array of $$$n$$$ positive integers $$$p_0, p_1, \dots, p_{n - 1}$$$, where $$$p_0$$$ is the initial price of the product and $$$p_i$$$ is how the price was increased during the $$$i$$$-th month.Using these price changes you are asked to calculate the inflation coefficients for each month as the ratio of current price increase $$$p_i$$$ to the price at the start of this month $$$(p_0 + p_1 + \dots + p_{i - 1})$$$.Your boss said you clearly that the inflation coefficients must not exceed $$$k$$$ %, so you decided to increase some values $$$p_i$$$ in such a way, that all $$$p_i$$$ remain integers and the inflation coefficients for each month don't exceed $$$k$$$ %.You know, that the bigger changes — the more obvious cheating. That's why you need to minimize the total sum of changes.What's the minimum total sum of changes you need to make all inflation coefficients not more than $$$k$$$ %?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 100$$$; $$$1 \le k \le 100$$$) — the length of array $$$p$$$ and coefficient $$$k$$$. The second line of each test case contains $$$n$$$ integers $$$p_0, p_1, \dots, p_{n - 1}$$$ ($$$1 \le p_i \le 10^9$$$) — the array $$$p$$$.

For each test case, print the minimum total sum of changes you need to make all inflation coefficients not more than $$$k$$$ %.

NoteIn the first test case, you can, for example, increase $$$p_0$$$ by $$$50$$$ and $$$p_1$$$ by $$$49$$$ and get array $$$[20150, 50, 202, 202]$$$. Then you get the next inflation coefficients:   $$$\frac{50}{20150} \le \frac{1}{100}$$$;  $$$\frac{202}{20150 + 50} \le \frac{1}{100}$$$;  $$$\frac{202}{20200 + 202} \le \frac{1}{100}$$$; In the second test case, you don't need to modify array $$$p$$$, since the inflation coefficients are already good:   $$$\frac{1}{1} \le \frac{100}{100}$$$;  $$$\frac{1}{1 + 1} \le \frac{100}{100}$$$;

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

toArr :: (Num a, Read a) => String -> [a]
toArr = map (read :: Read a => String -> a) . words

toSolveInp :: (String, String) -> (Integer, [Integer])
toSolveInp (s, t) = (k, p)
    where p      = toArr t
          [_, k] = toArr s

go :: Integer -> Integer -> [Integer] -> Integer
go k acc [] = 0
go k acc (p : ps) = max 0 (leastAcc - acc) + go k (newAcc + p) ps
  where (d, m) = divMod (100 * p) k
        leastAcc = if m > 0 then d + 1 else d
        newAcc = max acc leastAcc

solve :: Integer -> [Integer] -> Integer
solve k (p : ps) = go k p ps

main :: IO ()
main = interact
  (unlines . map (show . uncurry solve . toSolveInp) . pairUp . tail . lines)

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Integer -> [Integer] -> Integer
solve k (p : ps) = go p ps
    where go acc [] = 0
          go acc (p : ps) = max 0 (leastAcc - acc) + go (newAcc + p) ps
            where (d, m) = divMod (100 * p) k
                  leastAcc = if m > 0 then d + 1 else d
                  newAcc = max acc leastAcc

-- p / acc <= k / 100
-- 100 * p <= k * acc

main :: IO ()
main = interact (unlines . map (show . uncurry solve . toInp) . pairUp . tail . lines)
    where toArr = map (read :: String -> Integer) . words
          toInp (s, t) = (k, p)
            where p = toArr t
                  [n, k] = toArr s

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Maybe
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
--import Debug.Trace

--debug = flip trace
readx = fromInteger . fst . fromJust. BS.readInteger <$> BS.getLine
readxs =  map (fromInteger . fst . fromJust. BS.readInteger) . BS.words <$> BS.getLine

printList :: Show a => [a] -> IO ()
printList [] = return ()
printList [a] = print a
printList (a:xs) = putStr (show a) >> putChar ' ' >> printList xs

solve :: Int64 -> Int64 -> [Int64] -> Int64
solve k = foldl func
    where func preSum x = preSum+x+needAdd
            where minPS = (100*x+k-1) `div` k
                  needAdd = if minPS > preSum then minPS - preSum else 0

main :: IO()
main =  do
   t <- readx
   replicateM_ t $ do
       (n:k:_) <- readxs
       (p0:p) <- readxs
       print $ solve k p0 p - p0 - sum p

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Maybe
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
--import Debug.Trace

--debug = flip trace
readx = fromInteger . fst . fromJust. BS.readInteger <$> BS.getLine
readxs =  map (fromInteger . fst . fromJust. BS.readInteger) . BS.words <$> BS.getLine

printList :: Show a => [a] -> IO ()
printList [] = return ()
printList [a] = print a
printList (a:xs) = putStr (show a) >> putChar ' ' >> printList xs

solve :: Int64 -> [Int64] -> Int64 -> Int64
solve presum [] _ = 0
solve presum (x:xs) k = needAdd + solve (presum+x+needAdd) xs k
    where minPS = (100*x+k-1) `div` k
          needAdd = if minPS > presum then minPS - presum else 0

main :: IO()
main =  do
   t <- readx
   replicateM_ t $ do
       (n:k:_) <- readxs
       (p0:p) <- readxs
       print $ solve p0 p k

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine :: IO [Integer]
  ps <- map read . words <$> getLine :: IO [Integer]
  print $ maximum $ (0 :) $ zipWith (\p a -> (100 * p - 1) `div` k + 1 - a) (tail ps) (scanl1 (+) ps)

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Integer]

solve [] _ _ = 0
solve (x:xs) s k = solve xs (s+x+r) k + r
            where
                d = div (100*x+k-1) k
                r = if d <= s then 0 else d - s

printResult = do
    [n,k] <- readInts
    (p:ps) <- readInts
    print $ solve ps p k

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, k] <- getInts
    ps <- getInts
    let
      qs = tail $ scanl' (+) (0 :: Integer) (map fromIntegral $ take (length ps - 1) ps)
      check x = all id $ map (\(q, p) -> 100 * p <= fromIntegral k * (q + x)) $ zip qs (map fromIntegral $ tail ps)
      func low high
        | low == high = low
        | check x = func low x
        | otherwise = func (x + 1) high
        where
        x = (low + high) `div` 2
    C.putStrLn $ C.pack $ show $ func 0 ((10 :: Integer) ^ 18)

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

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

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

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

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

solve :: Int -> Int64 -> [Int64] -> Int64
solve n k ps = solve' (head ps) (tail ps)
    where
        solve' :: Int64 -> [Int64] -> Int64
        solve' _ [] = 0
        solve' sumP ps@(p:restPs) = max currentDeltaP $ solve' (sumP + p) restPs
            where
                currentDeltaP = max 0 $ (p * 100 - k * sumP + k - 1) `div` k

                    -- (p * 100 - k * sumP) / k <=deltaP

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, k] <- B8.getLine <&> map readIntB8 . B8.words
        ps <- B8.getLine <&> map readIntB8 . B8.words
        let answer = solve n (fromIntegral k) (map fromIntegral ps)
        printf "%lld\n" answer

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    p <- map fromIntegral <$> readInts
    let
      k' = fromIntegral k :: Int64
      ps = scanl' (+) 0 p
      rates = tail [ceilDiv (v * 100) k' - s | (v, s) <- zip p ps]
      ans = maximum (0:rates)
    lift . print $ ans

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

toArr :: (Num a, Read a) => String -> [a]
toArr = map (read :: Read a => String -> a) . words

toSolveInp :: (String, String) -> (Int, [Int])
toSolveInp (s, t) = (k, p)
    where p      = toArr t
          [_, k] = toArr s

go :: Int -> Int -> [Int] -> Int
go k acc [] = 0
go k acc (p : ps) = max 0 (leastAcc - acc) + go k (newAcc + p) ps
  where (d, m) = divMod (100 * p) k
        leastAcc = if m > 0 then d + 1 else d
        newAcc = max acc leastAcc

solve :: Int -> [Int] -> Int
solve k (p : ps) = go k p ps

main :: IO ()
main = interact
  (unlines . map (show . uncurry solve . toSolveInp) . pairUp . tail . lines)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine :: IO [Integer]
  ps <- map read . words <$> getLine :: IO [Integer]
  print $ maximum $ (0 :) $ zipWith (\p a -> 100 * p - a * k) (tail ps) (scanl1 (+) ps)


Polycarp wants to buy exactly $$$n$$$ shovels. The shop sells packages with shovels. The store has $$$k$$$ types of packages: the package of the $$$i$$$-th type consists of exactly $$$i$$$ shovels ($$$1 \le i \le k$$$). The store has an infinite number of packages of each type.Polycarp wants to choose one type of packages and then buy several (one or more) packages of this type. What is the smallest number of packages Polycarp will have to buy to get exactly $$$n$$$ shovels?For example, if $$$n=8$$$ and $$$k=7$$$, then Polycarp will buy $$$2$$$ packages of $$$4$$$ shovels.Help Polycarp find the minimum number of packages that he needs to buy, given that he:   will buy exactly $$$n$$$ shovels in total;  the sizes of all packages he will buy are all the same and the number of shovels in each package is an integer from $$$1$$$ to $$$k$$$, inclusive.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then, $$$t$$$ test cases follow, one per line. Each test case consists of two positive integers $$$n$$$ ($$$1 \le n \le 10^9$$$) and $$$k$$$ ($$$1 \le k \le 10^9$$$) — the number of shovels and the number of types of packages.

Print $$$t$$$ answers to the test cases. Each answer is a positive integer — the minimum number of packages.

NoteThe answer to the first test case was explained in the statement.In the second test case, there is only one way to buy $$$8$$$ shovels — $$$8$$$ packages of one shovel.In the third test case, you need to buy a $$$1$$$ package of $$$6$$$ shovels.

import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    print $ f n k

f :: Int -> Int -> Int
f n k =
    minimum
        . filter (\x -> div n x <= k)
        . concatMap (\x -> [x, div n x])
        . filter (\x -> mod n x == 0)
        $ takeWhile (\x -> x * x <= n) [1 ..]

{-- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.Bool
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    (n:k:_) <- map read . words <$> getLine
    print $
        minimum
            [ n `div` d
            | d1 <- [1 .. min (ceiling $ sqrt $ fromIntegral n) k]
            , n `mod` d1 == 0
            , d <- [d1, n `div` d1]
            , d <= k
            ]

import Control.Monad (replicateM_)

getDivisors n limit = [x | x <- [1 .. limit], n `mod` x == 0]

getShovelType :: [Int] -> Int
getShovelType [n, k] =
    if length beforeSqrt == 0 then head afterSqrt
    else head beforeSqrt
    where
        limit = (round . sqrt . fromIntegral) n
        divisors = getDivisors n limit
        beforeSqrt = filter (\x -> n `div` x <= k) divisors
        afterSqrt = filter (\x -> n `div` x <= k) ((reverse . map (\x -> n `div` x)) divisors)

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

main =
    read <$> getLine >>= \t ->
    replicateM_ t (getShovelType <$> readLine >>= print)

import Control.Monad ( replicateM_ )

readInput = (map read . words <$> getLine)

buyingShovels :: [Int] -> Int
buyingShovels [n, k] = head (cands' ++ cands'')
    where upper = ceiling.sqrt.fromIntegral $ n
          cands' = filter (\x -> n`mod`x==0 && n`div`x<=k) [1..upper]
          cands'' = [n`div`x | x<-[upper,upper-1..1], n`mod`x==0, x<=k]

main = do
    t <- read <$> getLine
    replicateM_ t (buyingShovels <$> readInput >>= print)

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/D

import Control.Monad ( replicateM_ )

buyingShovels :: [Int] -> Int
buyingShovels [n, k] = head (cands1 ++ cands2) where
    upper = ceiling . sqrt . fromIntegral $ n
    increasing = [1 .. upper]
    decreasing = [upper, upper-1 .. 1]
    cands1 = [x | x <- increasing, n `div` x <= k, n `mod` x == 0]
    cands2 = [n `div` x | x <- decreasing, x <= k, n `mod` x == 0]

readInput :: IO [Int]
readInput = map read . words <$> getLine

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (buyingShovels <$> readInput >>= print)

parse :: String -> [(Int, Int)]
parse inp = [(n, k) | [n, k] <- map (map read . words) . tail $ lines inp]

factors :: Int -> [Int]
factors n = sf ++ reverse (map (quot n) sf)  where
  sf = [w | w <- takeWhile (\w -> w*w <= n) [1..], rem n w == 0]

solve :: (Int, Int) -> Int
solve (n, k) = (quot n) . last . filter (<= k) $ factors n

showAns :: [Int] -> String
showAns = unlines . map show

main :: IO ()
main = interact (showAns . map solve . parse)

import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    print $ f n k

f :: Int -> Int -> Int
f n k | null pds  = n
      | otherwise = minimum pds
  where
    pds =
        filter (\x -> x * k >= n)
            . concatMap (\x -> [x, div n x])
            . filter (\x -> mod n x == 0)
            . takeWhile (\x -> x * x <= n)
            $ dropWhile (\x -> x * k < n) [1 ..]

import           Data.List
import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    let m = maxBound :: Int
    print $ f n k

f :: Int -> Int -> Int
-- x * y = n 1<=x<=k
f n k | null pds  = n
      | otherwise = head pds
  where
    pds =
        filter (\x -> mod n x == 0) . takeWhile (\x -> x * x <= n) $ dropWhile
            (\x -> x * k < n)
            (1 : 2 : [3, 5 ..])

import           Data.List
import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    let m = maxBound :: Int
    print $ f n k

f :: Int -> Int -> Int
-- n = x * y x is minimum then y is maximum
f n k | not . null $ divs = n `div` head divs
      | k >= n            = 1
      | otherwise         = n
  where
    divs = filter ((0 ==) . (n `mod`))
                  (2 : takeWhile (\x -> x * x <= n && x <= k) [3, 5 ..])

import           Data.List
import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    let m = maxBound :: Int
    print $ f n k

f :: Int -> Int -> Int
-- x * y = n 1<=x<=k
f n k | null pds  = n
      | otherwise = head pds
  where
    pds =
        filter (\x -> mod n x == 0) . takeWhile (\x -> x * x <= n) $ dropWhile
            (\x -> x * k < n)
            [1 ..]

import           Data.List
import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    let m = maxBound :: Int
    print $ f n k

f :: Int -> Int -> Int
-- n = x * y x is minimum then y is maximum
f n k | not . null $ divs = head divs
      | k >= n            = 1
      | otherwise         = n
  where
    divs = filter ((0 ==) . (n `mod`))
                  (takeWhile (\x -> x * x <= n && x <= k) [start ..])
    start = ceiling $ (fromIntegral n) / (fromIntegral k)

import           Data.List
import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    let m = maxBound :: Int
    print $ f n k

f :: Int -> Int -> Int
-- n = x * y x is minimum then y is maximum
f n k | not . null $ divs = head divs
      | otherwise         = n
  where
    divs = filter ((0 ==) . (n `mod`))
                  (takeWhile (\x -> x * x <= n && x <= k) [start ..])
    start = ceiling $ (fromIntegral n) / (fromIntegral k)

import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    print $ f n k

f :: Int -> Int -> Int
f n k | null pds  = n
      | otherwise = head pds
  where
    pds =
        filter (\x -> mod n x == 0) . takeWhile (\x -> x * x <= n) $ dropWhile
            (\x -> x * k < n)
            [1 ..]

import           Control.Monad

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

solve :: IO ()
solve = do
    [n, k] <- map read . words <$> getLine
    print $ f n k

f :: Int -> Int -> Int
f n k | null pds  = n
      | otherwise = minimum pds
  where
    pds =
        filter (\x -> mod n x == 0) . takeWhile (\x -> x * x <= n) $ dropWhile
            (\x -> x * k < n)
            [1 ..]

import Control.Monad (replicateM_)

getDivisors n limit = [x | x <- [1 .. limit], n `mod` x == 0]

getShovelType :: [Int] -> Int
getShovelType [n, k] =
    if length beforeSqrt == 0 then head afterSqrt
    else head beforeSqrt
    where
        limit = (round . sqrt . fromIntegral) n
        divisors = getDivisors n limit
        beforeSqrt = filter (\x -> n `div` x <= k) divisors
        afterSqrt = filter (\x -> n `div` x <= k) (map (\x -> n `div` x) divisors)

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

main =
    read <$> getLine >>= \t ->
    replicateM_ t (getShovelType <$> readLine >>= print)

import Control.Monad ( replicateM_ )

readInput = map read . words <$> getLine

buyingShovels :: [Int] -> Int
buyingShovels [n, k] = head cands'
    where cands' = filter (\x -> n`mod`x==0 && n`div`x<=k) cands
          cands = [1..(ceiling.sqrt.fromIntegral $ n)] ++ [n]

main = do
    t <- read <$> getLine
    replicateM_ t (buyingShovels <$> readInput >>= print)


There are $$$n$$$ houses in a row. They are numbered from $$$1$$$ to $$$n$$$ in order from left to right. Initially you are in the house $$$1$$$.You have to perform $$$k$$$ moves to other house. In one move you go from your current house to some other house. You can't stay where you are (i.e., in each move the new house differs from the current house). If you go from the house $$$x$$$ to the house $$$y$$$, the total distance you walked increases by $$$|x-y|$$$ units of distance, where $$$|a|$$$ is the absolute value of $$$a$$$. It is possible to visit the same house multiple times (but you can't visit the same house in sequence).Your goal is to walk exactly $$$s$$$ units of distance in total.If it is impossible, print "NO". Otherwise print "YES" and any of the ways to do that. Remember that you should do exactly $$$k$$$ moves.

The first line of the input contains three integers $$$n$$$, $$$k$$$, $$$s$$$ ($$$2 \le n \le 10^9$$$, $$$1 \le k \le 2 \cdot 10^5$$$, $$$1 \le s \le 10^{18}$$$) — the number of houses, the number of moves and the total distance you want to walk.

If you cannot perform $$$k$$$ moves with total walking distance equal to $$$s$$$, print "NO". Otherwise print "YES" on the first line and then print exactly $$$k$$$ integers $$$h_i$$$ ($$$1 \le h_i \le n$$$) on the second line, where $$$h_i$$$ is the house you visit on the $$$i$$$-th move. For each $$$j$$$ from $$$1$$$ to $$$k-1$$$ the following condition should be satisfied: $$$h_j \ne h_{j + 1}$$$. Also $$$h_1 \ne 1$$$ should be satisfied.

{-# LANGUAGE BangPatterns #-}
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 System.IO
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

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

getInts :: IO [Integer]
getInts = construct `fmap` BS.getLine

fastPrint :: Char -> [Int] -> IO ()
fastPrint mid arr = hPutBuilder stdout  $ build arr
    where build = foldr (\n b -> intDec n <> charUtf8 mid <> b) mempty

solve n 0 s p = if s > 0 then [-1] else []
solve n k s p
    | s < k = [-1]
    | s == k =  let np = if p == 1 then 2 else p - 1 in np : solve n (k-1) (s-1) np
    | otherwise = rv : solve n (k-1) (max (s-(n-1)) (k-1)) rv
    where rv = if s - (n - 1) >= k - 1 then (if p == 1 then n else 1)
               else (let m = s - (k - 1) in if p == 1 then p + m else p - m)

main = do
    [n,k,s] <- getInts
    let ls = solve n k s 1
    if not (null (filter (<0) ls)) then putStrLn "NO"
    else putStrLn "YES" >> putStrLn (intercalate " " $ map show ls)


It's hard times now. Today Petya needs to score 100 points on Informatics exam. The tasks seem easy to Petya, but he thinks he lacks time to finish them all, so he asks you to help with one..There is a glob pattern in the statements (a string consisting of lowercase English letters, characters "?" and "*"). It is known that character "*" occurs no more than once in the pattern.Also, n query strings are given, it is required to determine for each of them if the pattern matches it or not.Everything seemed easy to Petya, but then he discovered that the special pattern characters differ from their usual meaning.A pattern matches a string if it is possible to replace each character "?" with one good lowercase English letter, and the character "*" (if there is one) with any, including empty, string of bad lowercase English letters, so that the resulting string is the same as the given string.The good letters are given to Petya. All the others are bad.

The first line contains a string with length from 1 to 26 consisting of distinct lowercase English letters. These letters are good letters, all the others are bad. The second line contains the pattern — a string s of lowercase English letters, characters "?" and "*" (1 ≤ |s| ≤ 105). It is guaranteed that character "*" occurs in s no more than once. The third line contains integer n (1 ≤ n ≤ 105) — the number of query strings. n lines follow, each of them contains single non-empty string consisting of lowercase English letters — a query string. It is guaranteed that the total length of all query strings is not greater than 105.

Print n lines: in the i-th of them print "YES" if the pattern matches the i-th query string, and "NO" otherwise. You can choose the case (lower or upper) for each letter arbitrary.

NoteIn the first example we can replace "?" with good letters "a" and "b", so we can see that the answer for the first query is "YES", and the answer for the second query is "NO", because we can't match the third letter.Explanation of the second example.   The first query: "NO", because character "*" can be replaced with a string of bad letters only, but the only way to match the query string is to replace it with the string "ba", in which both letters are good.  The second query: "YES", because characters "?" can be replaced with corresponding good letters, and character "*" can be replaced with empty string, and the strings will coincide.  The third query: "NO", because characters "?" can't be replaced with bad letters.  The fourth query: "YES", because characters "?" can be replaced with good letters "a", and character "*" can be replaced with a string of bad letters "x".

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as B

main = do
  gs <- getLine
  p <- getLine
  n <- fmap readInt B.getLine
  qs <- replicateM n getLine
  putStr $ unlines $ map (\x -> if x then "YES" else "NO") $ solve gs p qs

solve gs pt = map (ok pt)
  where
    bs = ['a'..'z'] \\ gs
    ok [] [] = True
    ok "*" [] = True
    ok _ [] = False
    ok [] _ = False
    ok (p:ps) (q:qs)
      | p == q = ok ps qs
      | p == '?' = q `elem` gs && ok ps qs
      | p == '*' = ok ps (q:qs) || q `elem` bs && ok (p:ps) qs
      | otherwise = False

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

{-
f [] ['*'] _ = "YES"
f [] [] _ = "YES"
f _ [] _ = "NO"
f [] _ _ = "NO"
f xx@(x:xs) tt@(t:ts) dict
	|t==x = f xs ts dict
	|t=='?' && inDict =f xs ts dict
	|t=='*' && length xs<length ts = f xx ts dict
	|t=='*' && not inDict = f xs tt dict
	|t=='*' && elem x dict = f xx ts dict
	|otherwise = "NO"
	where inDict = elem x dict

extract (x:y:n:xs)=(x,y,read n::Int,xs)

solve (dict,template,n,xs)=map (\d->f d template dict ) $ take n xs

main=interact$unlines.solve.extract.lines

-}

import Control.Applicative( (<$>))
import Control.Monad( replicateM, forM_)

main = do
    goodLetters_ <- getLine
    expression_ <- getLine
    n_ <- readLn
    queries_ <- replicateM n_ getLine
    let
	isMatch [] [] = [True]
	isMatch "*" [] = [True]
	isMatch _ [] = [False]
	isMatch [] _ = [False]
	isMatch exp@(e:xpression) q@(c:cs) = case e of
	    '?'	-> if c `elem` goodLetters_
		    then isMatch xpression cs
		    else [False]
	    '*'	-> if c `elem` goodLetters_
		    then isMatch xpression q
		    else (isMatch xpression q)++(isMatch exp cs)
	    e	-> if e==c then isMatch xpression cs else [False]

	putStr' query = putStrLn $
			    if or $ isMatch expression_ query
				then "YES"
				else "NO"
    forM_ queries_ putStr'

import Control.Monad( replicateM)

extract (x:y:n:xs)=(x,y,read n::Int,xs)

sel "YES" _ = "YES"
sel _ "YES" = "YES"
sel _ _ ="NO"
main=do
	dict<-getLine
	template<-getLine
	n<-readLn
	xs<-replicateM n getLine
	let
		f [] [] = "YES"
		f "*" [] = "YES"
		f _ [] = "NO"
		f [] _ = "NO"
		f exp@(e:xpression) q@(c:cs) = case e of
			'?'	-> if c `elem` dict
				then f xpression cs
				else "NO"
			'*'	-> if c `elem` dict
				then f xpression q
				else sel (f xpression q) (f exp cs)
			e	-> if e==c then f xpression cs else "NO"

		res=map (\d->f template d) xs
	mapM_ putStrLn $ res

import Control.Monad( replicateM)

extract (x:y:n:xs)=(x,y,read n::Int,xs)

main=do
	dict<-getLine
	template<-getLine
	n<-readLn
	xs<-replicateM n getLine
	let
		f [] [] = "YES"
		f "*" [] = "YES"
		f _ [] = "NO"
		f [] _ = "NO"
		f exp@(e:xpression) q@(c:cs) = case e of
			'?'	-> if c `elem` dict
				then f xpression cs
				else "NO"
			'*'	-> if c `elem` dict
				then f xpression q
				else (f exp cs)
			e	-> if e==c then f xpression cs else "NO"

		res=map (\d->f template d) xs
	mapM_ putStrLn $ res

import Control.Monad( replicateM)

extract (x:y:n:xs)=(x,y,read n::Int,xs)

main=do
	dict<-getLine
	template<-getLine
	n<-readLn
	xs<-replicateM n getLine
	let
		f [] [] = "YES"
		f "*" [] = "YES"
		f _ [] = "NO"
		f [] _ = "NO"
		f exp@(e:xpression) q@(c:cs) = case e of
			'?'	-> if c `elem` dict
				then f xpression cs
				else "NO"
			'*'	-> if c `elem` dict
				then f xpression q
				else (f xpression q)++(f exp cs)
			e	-> if e==c then f xpression cs else "NO"

		res=map (\d->f template d) xs
	mapM_ putStrLn $ res

f [] ['*'] _ = "YES"
f [] [] _ = "YES"
f _ [] _ = "NO"
f [] _ _ = "NO"
f xx@(x:xs) tt@(t:ts) dict
	|t==x = f xs ts dict
	|t=='?' && elem x dict =f xs ts dict
	|t=='*' && not (elem x dict) = f xs tt dict
	|t=='*' && elem x dict = f xx ts dict
	|otherwise = "NO"

extract (x:y:n:xs)=(x,y,read n::Int,xs)

solve (dict,template,n,xs)=map (\d->f d template dict ) $ take n xs

main=interact$unlines.solve.extract.lines

import Control.Applicative( (<$>))
import Control.Monad( replicateM, forM_)

main = do
    goodLetters_ <- getLine
    expression_ <- getLine
    n_ <- readLn
    queries_ <- replicateM n_ getLine
    let
	isMatch [] [] = [True]
	isMatch "*" [] = [True]
	isMatch _ [] = [False]
	isMatch [] _ = [False]
	isMatch exp@(e:xpression) q@(c:cs) = case e of
	    '?'	-> if c `elem` goodLetters_
		    then isMatch xpression cs
		    else [False]
	    '*'	-> if c `elem` goodLetters_
		    then isMatch xpression q
		    else (isMatch xpression cs)++(isMatch exp cs)
	    e'	-> if e'==c then isMatch xpression cs else [False]

	putStr' query = putStrLn $
			    if or $ isMatch expression_ query
				then "YES"
				else "NO"
    forM_ queries_ putStr'

import Control.Applicative( (<$>))
import Control.Monad( replicateM, forM_)

main = do
    goodLetters_ <- getLine
    expression_ <- getLine
    n_ <- readLn
    queries_ <- replicateM n_ getLine
    let
	isMatch "*" [] = [True]
	isMatch [] [] = [True]
	isMatch _ [] = [False]
	isMatch [] _ = [False]
	isMatch exp@(e:xpression) q@(c:cs) = case e of
	    '?'	-> if c `elem` goodLetters_
		    then isMatch xpression cs
		    else [False]
	    '*'	-> if c `elem` goodLetters_
		    then isMatch xpression q
		    else (isMatch xpression cs)++(isMatch exp cs)
	    e	-> if e==c then isMatch xpression cs else [False]

	putStr' query = putStrLn $
			    if or $ isMatch expression_ query
				then "YES"
				else "NO"
    forM_ queries_ putStr'


Two villages are separated by a river that flows from the north to the south. The villagers want to build a bridge across the river to make it easier to move across the villages.The river banks can be assumed to be vertical straight lines x = a and x = b (0 < a < b).The west village lies in a steppe at point O = (0, 0). There are n pathways leading from the village to the river, they end at points Ai = (a, yi). The villagers there are plain and simple, so their pathways are straight segments as well.The east village has reserved and cunning people. Their village is in the forest on the east bank of the river, but its exact position is not clear. There are m twisted paths leading from this village to the river and ending at points Bi = (b, y'i). The lengths of all these paths are known, the length of the path that leads from the eastern village to point Bi, equals li.The villagers want to choose exactly one point on the left bank of river Ai, exactly one point on the right bank Bj and connect them by a straight-line bridge so as to make the total distance between the villages (the sum of |OAi| + |AiBj| + lj, where |XY| is the Euclidean distance between points X and Y) were minimum. The Euclidean distance between points (x1, y1) and (x2, y2) equals .Help them and find the required pair of points.

The first line contains integers n, m, a, b (1 ≤ n, m ≤ 105, 0 < a < b < 106).  The second line contains n integers in the ascending order: the i-th integer determines the coordinate of point Ai and equals yi (|yi| ≤ 106).  The third line contains m integers in the ascending order: the i-th integer determines the coordinate of point Bi and equals y'i (|y'i| ≤ 106).  The fourth line contains m more integers: the i-th of them determines the length of the path that connects the eastern village and point Bi, and equals li (1 ≤ li ≤ 106). It is guaranteed, that there is such a point C with abscissa at least b, that |BiC| ≤ li for all i (1 ≤ i ≤ m). It is guaranteed that no two points Ai coincide. It is guaranteed that no two points Bi coincide.

Print two integers — the numbers of points on the left (west) and right (east) banks, respectively, between which you need to build a bridge. You can assume that the points on the west bank are numbered from 1 to n, in the order in which they are given in the input. Similarly, the points on the east bank are numbered from 1 to m in the order in which they are given in the input. If there are multiple solutions, print any of them. The solution will be accepted if the final length of the path will differ from the answer of the jury by no more than 10 - 6 in absolute or relative value.

import Data.Maybe
import qualified Data.ByteString.Char8 as C

main = do
  let readInt =  fst . fromJust . C.readInt
  (n:m:input) <- fmap (map (readInt) . C.words) C.getContents
  let (u:v:a, input') = splitAt (n+2) $ map fromIntegral input
      (b, c) = splitAt m input'
      (ans, x, y) = minimum $ gao u v (zip [1 ..] a) (zip3 [1 ..] b c)
  putStrLn $ show x ++ " " ++ show y

hypot x y = sqrt $ x * x + y * y

gao u v a b = go a b
  where
    go _ [] = []
    go a ((j, r, d): t) = (dist l, i, j): go a' t
      where
        dist l = hypot u l + hypot (v - u) (r - l) + d
        a'@((i, l): _) = best a
        best [h] = [h]
        best l1@((_, h1): l2@((_, h2): t)) =
          if dist h2 <= dist h1 then best l2 else l1

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as BS
import Data.Maybe

main = do
    [[_, _, ax, bx], ays, bys, ls] <- fmap (map (map (fromIntegral . fst . fromJust . BS.readInt) . BS.words) . BS.lines) BS.getContents :: IO [[Double]]
    let ds = map (\ay -> dist (0, 0) (ax, ay)) ays
    let (len, i, j) = solve 1 1 ax bx ays bys ds ls []
    putStr $ show i ++ " " ++ show j
    where
        solve _ _ _ _ _ [] _ [] anss = minimum anss
        solve i j ax bx [ay] bys [d] ls anss = solve i j ax bx [ay, 10 ^ 10] bys [d, 10 ^ 10] ls anss
        solve i j ax bx (ay1:ay2:ays) (by:bys) (d1:d2:ds) (l:ls) anss = if d1 + dist (ax, ay1) (bx, by) >= d2 + dist (ax, ay2) (bx, by)
            then solve (i + 1) j ax bx (ay2:ays) (by:bys) (d2:ds) (l:ls) anss
            else solve i (j + 1) ax bx (ay1:ay2:ays) bys (d1:d2:ds) ls $ (d1 + dist (ax, ay1) (bx, by) + l, i, j):anss

dist (x1, y1) (x2, y2) = sqrt $ (x1 - x2) ^ 2 + (y1 - y2) ^ 2

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as BS
import Data.Maybe

main = do
    [[_, _, ax, bx], ays, bys, ls] <- fmap (map (map (fromIntegral . fst . fromJust . BS.readInt) . BS.words) . BS.lines) BS.getContents
    let (len, i, j) = solve 1 1 ax bx ays bys ls []
    putStr $ show i ++ " " ++ show j
    where
        solve _ _ _ _ _ [] [] anss = minimum anss
        solve i j ax bx [ay] bys ls anss = solve i j ax bx [ay, 10 ^ 10] bys ls anss
        solve i j ax bx (ay1:ay2:ays) (by:bys) (l:ls) anss = if dist (0, 0) (ax, ay1) + dist (ax, ay1) (bx, by) >= dist (0, 0) (ax, ay2) + dist (ax, ay2) (bx, by)
            then solve (i + 1) j ax bx (ay2:ays) (by:bys) (l:ls) anss
            else solve i (j + 1) ax bx (ay1:ay2:ays) bys ls $ (dist (0, 0) (ax, ay1) + dist (ax, ay1) (bx, by) + l, i, j):anss

dist (x1, y1) (x2, y2) = sqrt $ (x1 - x2) ^ 2 + (y1 - y2) ^ 2

import Data.Maybe
import qualified Data.ByteString.Char8 as C

main = do
  let readInt =  fst . fromJust . C.readInt
  (n:m:input) <- fmap (map (readInt) . C.words) C.getContents
  let (u:v:a, input') = splitAt (n+2) $ map fromIntegral input
      (b, c) = splitAt m input'
      (ans, x, y) = minimum $ gao u v (zip [1 ..] a) (zip3 [1 ..] b c)
  putStrLn $ show x ++ " " ++ show y

hypot x y = sqrt $ x * x + y * y

gao u v a b = go a b
  where
    go _ [] = []
    go a ((j, r, d): t) = (dist l, i, j): go a' t
      where
        dist l = hypot u l + hypot (v - u) (r - l) + d
        a'@((i, l): _) = best a
        best [h] = [h]
        best l1@((_, h1): l2@((_, h2): t)) =
          if dist h2 < dist h1 then l2 else l1


You are given an array $$$a$$$ consisting of $$$n$$$ integer numbers.You have to color this array in $$$k$$$ colors in such a way that:   Each element of the array should be colored in some color;  For each $$$i$$$ from $$$1$$$ to $$$k$$$ there should be at least one element colored in the $$$i$$$-th color in the array;  For each $$$i$$$ from $$$1$$$ to $$$k$$$ all elements colored in the $$$i$$$-th color should be distinct. Obviously, such coloring might be impossible. In this case, print "NO". Otherwise print "YES" and any coloring (i.e. numbers $$$c_1, c_2, \dots c_n$$$, where $$$1 \le c_i \le k$$$ and $$$c_i$$$ is the color of the $$$i$$$-th element of the given array) satisfying the conditions above. If there are multiple answers, you can print any.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 5000$$$) — the length of the array $$$a$$$ and the number of colors, respectively. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 5000$$$) — elements of the array $$$a$$$.

If there is no answer, print "NO". Otherwise print "YES" and any coloring (i.e. numbers $$$c_1, c_2, \dots c_n$$$, where $$$1 \le c_i \le k$$$ and $$$c_i$$$ is the color of the $$$i$$$-th element of the given array) satisfying the conditions described in the problem statement. If there are multiple answers, you can print any.

NoteIn the first example the answer $$$2~ 1~ 2~ 1$$$ is also acceptable.In the second example the answer $$$1~ 1~ 1~ 2~ 2$$$ is also acceptable.There exist other acceptable answers for both examples.

import Data.Function
import Data.Functor
import Data.List hiding (sortOn)
import qualified Data.Map as M

toList :: (Read a) => String -> [a]
toList = (map read) <$> words

main = do
    [n, k] <- toList <$> getLine :: IO [Int]
    as <- toList <$> getLine :: IO [Int]
    let bs = sortOn snd $ zip [0 .. ] as
        m = maximum $ map length $ groupBy ((==) `on` snd) bs
        cs = zipWith (\(x,_) y -> (x, y)) bs (cycle [1 .. k])
    if m > k then do
        putStrLn "NO"
    else do
        putStrLn "YES"
        putStrLn $ unwords $ map (show . snd) $ sortOn fst cs

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn f = sortBy (compare `on` f)

import Data.Functor
import qualified Data.List as L
import qualified Data.Map as M

toList :: (Read a) => String -> [a]
toList = (map read) <$> words

addIndex :: [Int] -> [(Int, Int)]
addIndex = zip [1 .. ]

sortByValue :: [(Int, Int)] -> [(Int, Int)]
sortByValue = L.sortBy (\(_,x) (_,y) -> compare x y)

colorize :: Int -> [(Int, Int)] -> [(Int, Int)]
colorize k xs = zip (map fst xs) (cycle [1..k])

sortByIndex :: [(Int, Int)] -> [(Int, Int)]
sortByIndex = L.sort

output :: [(Int, Int)] -> IO ()
output xs = do
    putStrLn "YES"
    putStrLn $ L.intercalate " " (map (show . snd) xs)

main = do
    (n, k) <- (\[e1, e2] -> (e1, e2)) <$> toList <$> getLine :: IO (Int, Int)
    arr <- toList <$> getLine :: IO [Int]
    if (maximum $ map length $ L.group $ L.sort arr) > k || (length arr) < k
    then
        putStrLn "NO"
    else
        output . sortByIndex $ colorize k (sortByValue $ addIndex arr)

    return ()

-- Codeforces Round #531 (B), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.Function

main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine :: IO [Int]
  let ias = sorton snd $ zip [0..] as
      mink = maximum $ map length $ groupBy ((==) `on` snd) ias
      sortedAns = zipWith (\(i,a) c -> (i,c)) ias $ cycle [1..k]
      ans = map snd $ sorton fst sortedAns
  if mink <= k then do
    putStrLn "YES"
    putStrLn $ unwords $ map show ans
  else
    putStrLn "NO"

sorton f = sortBy (compare `on` f)


In the $$$2022$$$ year, Mike found two binary integers $$$a$$$ and $$$b$$$ of length $$$n$$$ (both of them are written only by digits $$$0$$$ and $$$1$$$) that can have leading zeroes. In order not to forget them, he wanted to construct integer $$$d$$$ in the following way:   he creates an integer $$$c$$$ as a result of bitwise summing of $$$a$$$ and $$$b$$$ without transferring carry, so $$$c$$$ may have one or more $$$2$$$-s. For example, the result of bitwise summing of $$$0110$$$ and $$$1101$$$ is $$$1211$$$ or the sum of $$$011000$$$ and $$$011000$$$ is $$$022000$$$;  after that Mike replaces equal consecutive digits in $$$c$$$ by one digit, thus getting $$$d$$$. In the cases above after this operation, $$$1211$$$ becomes $$$121$$$ and $$$022000$$$ becomes $$$020$$$ (so, $$$d$$$ won't have equal consecutive digits). Unfortunately, Mike lost integer $$$a$$$ before he could calculate $$$d$$$ himself. Now, to cheer him up, you want to find any binary integer $$$a$$$ of length $$$n$$$ such that $$$d$$$ will be maximum possible as integer.Maximum possible as integer means that $$$102 > 21$$$, $$$012 < 101$$$, $$$021 = 21$$$ and so on.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains the integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the length of $$$a$$$ and $$$b$$$. The second line of each test case contains binary integer $$$b$$$ of length $$$n$$$. The integer $$$b$$$ consists only of digits $$$0$$$ and $$$1$$$. It is guaranteed that the total sum of $$$n$$$ over all $$$t$$$ test cases doesn't exceed $$$10^5$$$.

For each test case output one binary integer $$$a$$$ of length $$$n$$$. Note, that $$$a$$$ or $$$b$$$ may have leading zeroes but must have the same length $$$n$$$.

NoteIn the first test case, $$$b = 0$$$ and choosing $$$a = 1$$$ gives $$$d = 1$$$ as a result.In the second test case, $$$b = 011$$$ so:   if you choose $$$a = 000$$$, $$$c$$$ will be equal to $$$011$$$, so $$$d = 01$$$;  if you choose $$$a = 111$$$, $$$c$$$ will be equal to $$$122$$$, so $$$d = 12$$$;  if you choose $$$a = 010$$$, you'll get $$$d = 021$$$.  If you select $$$a = 110$$$, you'll get $$$d = 121$$$.  We can show that answer $$$a = 110$$$ is optimal and $$$d = 121$$$ is maximum possible.In the third test case, $$$b = 110$$$. If you choose $$$a = 100$$$, you'll get $$$d = 210$$$ and it's the maximum possible $$$d$$$.In the fourth test case, $$$b = 111000$$$. If you choose $$$a = 101101$$$, you'll get $$$d = 212101$$$ and it's maximum possible $$$d$$$.In the fifth test case, $$$b = 001011$$$. If you choose $$$a = 101110$$$, you'll get $$$d = 102121$$$ and it's maximum possible $$$d$$$.

solve :: String -> String
solve = go '*'
    where go last [] = []
          go last (c : t)
            | succ c == last = '0' : go c t
            | otherwise      = '1' : go (succ c) t

main :: IO ()
main = interact (unlines . map solve . takeEven . tail . lines)
    where takeEven l = map snd $ filter (even . fst) (zip [1..] l)

solve :: String -> String
solve s = '1' : go (p $ head s) (tail s)
    where go last [] = []
          go last [c] = if p c == last then "0" else "1"
          go last (c : d : t)
            | p c == last = '0' : go c (d : t)
            | otherwise   = '1' : go (p c) (d : t)
          p '0' = '1'
          p '1' = '2'

main :: IO ()
main = interact (unlines . map solve . takeOdd . tail . lines)
    where takeOdd [] = []
          takeOdd [x] = []
          takeOdd (x : y : z) = y : takeOdd z

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

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

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

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

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

solve :: String -> String
solve s = solve' (-1) s
    where
        solve' :: Int -> String -> String
        solve' _ [] = []
        solve' 1 ('0':s) = '0' : solve' 0 s
        solve' _ ('0':s) = '1' : solve' 1 s
        solve' 2 ('1':s) = '0' : solve' 1 s
        solve' _ ('1':s) = '1' : solve' 2 s

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        s <- B8.getLine <&> B8.unpack . head . B8.words
        let answer = solve s
        putStrLn answer

module Main where

work [] t=[]
work ('1':xs) 2='0':work xs 1
work ('1':xs) t='1':work xs 2
work ('0':xs) 1='0':work xs 0
work ('0':xs) t='1':work xs 1

run 1 = do
    l1 <- getLine
    l2 <- getLine
    let str=l2
    putStrLn $ work str 5

run x = do
    run 1
    run (x-1)

main = do
    l1 <- getLine
    let t = (read::String->Integer) l1
    run t

solve :: String -> String
solve s = go (head s) s
    where go last [] = []
          go last [c] = if c == last then "1" else "0"
          go last (c : d : t)
            | p c == last = '0' : go c (d : t)
            | otherwise   = '1' : go (p c) (d : t)
          p '0' = '1'
          p '1' = '2'

main :: IO ()
main = interact (unlines . map solve . takeOdd . tail . lines)
    where takeOdd [] = []
          takeOdd [x] = []
          takeOdd (x : y : z) = y : takeOdd z

solve :: String -> String
solve [] = []
solve [c] = "0"
solve (c : d : t)
    | c == d    = '1' : '0' : solve t
    | otherwise = '0' : solve (d : t)

main :: IO ()
main = interact (unlines . map solve . takeOdd . tail . lines)
    where takeOdd [] = []
          takeOdd [x] = []
          takeOdd (x : y : z) = y : takeOdd z

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

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

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

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

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

solve :: String -> String
solve s = solve' (-1) s
    where
        solve' :: Int -> String -> String
        solve' _ [] = []
        solve' 0 ('0':s) = '1' : solve' 1 s
        solve' _ ('0':s) = '0' : solve' 0 s
        solve' 1 ('1':s) = '1' : solve' 2 s
        solve' _ ('1':s) = '0' : solve' 1 s

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        s <- B8.getLine <&> B8.unpack . head . B8.words
        let answer = solve s
        putStrLn answer


You are given an array $$$a[0 \ldots n-1]$$$ of length $$$n$$$ which consists of non-negative integers. Note that array indices start from zero.An array is called good if the parity of each index matches the parity of the element at that index. More formally, an array is good if for all $$$i$$$ ($$$0 \le i \le n - 1$$$) the equality $$$i \bmod 2 = a[i] \bmod 2$$$ holds, where $$$x \bmod 2$$$ is the remainder of dividing $$$x$$$ by 2.For example, the arrays [$$$0, 5, 2, 1$$$] and [$$$0, 17, 0, 3$$$] are good, and the array [$$$2, 4, 6, 7$$$] is bad, because for $$$i=1$$$, the parities of $$$i$$$ and $$$a[i]$$$ are different: $$$i \bmod 2 = 1 \bmod 2 = 1$$$, but $$$a[i] \bmod 2 = 4 \bmod 2 = 0$$$.In one move, you can take any two elements of the array and swap them (these elements are not necessarily adjacent).Find the minimum number of moves in which you can make the array $$$a$$$ good, or say that this is not possible.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the test. Then $$$t$$$ test cases follow. Each test case starts with a line containing an integer $$$n$$$ ($$$1 \le n \le 40$$$) — the length of the array $$$a$$$. The next line contains $$$n$$$ integers $$$a_0, a_1, \ldots, a_{n-1}$$$ ($$$0 \le a_i \le 1000$$$) — the initial array.

For each test case, output a single integer — the minimum number of moves to make the given array $$$a$$$ good, or -1 if this is not possible.

NoteIn the first test case, in the first move, you can swap the elements with indices $$$0$$$ and $$$1$$$, and in the second move, you can swap the elements with indices $$$2$$$ and $$$3$$$.In the second test case, in the first move, you need to swap the elements with indices $$$0$$$ and $$$1$$$.In the third test case, you cannot make the array good.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = do
	t <- readInt
	mapM_ print =<< replicateM t solve

solve = do
	n <- readInt
	as <- readInts
	let
		evens = length $ filter odd $ map fst $ filter snd $ zip as $ cycle [ True, False ]
		odds = length $ filter even $ map fst $ filter snd $ zip as $ cycle [ False, True ]
	return $ if evens == odds
		then evens
		else -1

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  _ <- getLine
  xs <- (map read.words) <$> getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = if ce == co then ce else -1
  where
    (e,o) = partition (even.snd) (zip xs [0..])
    (e',o') = (map fst e,map fst o)
    ce =length $ filter odd e'
    co = length $ filter even o'

main = do
  inputjar <- getLine
  let n = read inputjar :: Int
  solve n

solve :: Int -> IO ()
solve 0 = putStr ""
solve n = do
  _ <- getLine
  input <- getLine
  let list = read ("[" ++ map (\x -> if x == ' ' then ',' else x) input ++ "]") :: [Int]
  solveCase list
  solve (n - 1)

solveCase :: [Int] -> IO ()
solveCase xs = print $ if odd == even then odd else (-1)
  where
    odd = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 1 then 0 else 1) 0 [1, 3 .. length xs - 1]
    even = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 0 then 0 else 1) 0 [0, 2 .. length xs - 1]

import Data.Maybe (catMaybes)
import Data.List (sort, group)
import Control.Monad (replicateM_)

data Inversion = Even | Odd deriving (Eq, Ord)

f :: (Int, Int) -> Maybe Inversion
f (x,y) | even x && odd y = Just Even
        | odd x && even y = Just Odd
        | otherwise = Nothing

main = readLn >>= flip replicateM_ (getLine >> getLine >>= print . w . catMaybes . map f .  zip [0..] . map read . words)
    where w [] = 0
          w xs = case map length . group $ sort xs of
             [_] -> -1
             [a,b] -> if a==b then a else -1

import Control.Monad

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

main :: IO()
main = do
    [t] <- getInts
    replicateM_ t routine

routine :: IO()
routine = do
    [n] <- getInts
    a <- getInts
    let evens = [z | z <- (zip a [0..]), even $ fst z]
        badevens_count = length $ filter (\x -> odd $ snd x) evens
        odds = [z | z <- (zip a [0..]), odd $ fst z]
        badodds_count = length $ filter (\x -> even $ snd x) odds
    if badevens_count /= badodds_count then
        print (-1)
    else
        print badevens_count

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

process  e o  [] = if e==o then e else -1
process e o [a] | even a = process e o []
                |otherwise = process (e+1) o []

process e o (a:b:c) | even a && odd b = process e o c
                    | even a && even b = process e (o+1) c
		    | odd a && odd b = process (e+1) o c
		    | otherwise = process (e+1) (o+1) c

onecase = do
		getLine
		k<- map read <$> words <$> getLine ::IO [Int]
		print $ process 0 0 k

main = do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase

import Control.Monad

countOddEven [] o e l = (o, e, l)
countOddEven (a:t) o e l
  | a `mod` 2 == 0 = countOddEven t o (e + 1) (l + 1)
  | otherwise      = countOddEven t (o + 1) e (l + 1)

solve :: [Int] -> Int
solve lst =
  let
    (o, e, l) = countOddEven lst 0 0 0
  in
    if (abs (o - e)) /= l `mod` 2  then -1
    else
      let
        wrong = length (filter not (zipWith (\a b->a `mod` 2 /= b `mod` 2)[1..] lst))
      in
        if wrong `mod` 2 == 0 then wrong `div` 2 else -1

main = do
  n <- read <$> getLine
  a <- replicateM n (getLine >> getLine)
  let ainp = (map read) . words <$> a
  mapM_ (putStrLn . show . solve) $ ainp


William has a favorite bracket sequence. Since his favorite sequence is quite big he provided it to you as a sequence of positive integers $$$c_1, c_2, \dots, c_n$$$ where $$$c_i$$$ is the number of consecutive brackets "(" if $$$i$$$ is an odd number or the number of consecutive brackets ")" if $$$i$$$ is an even number.For example for a bracket sequence "((())()))" a corresponding sequence of numbers is $$$[3, 2, 1, 3]$$$.You need to find the total number of continuous subsequences (subsegments) $$$[l, r]$$$ ($$$l \le r$$$) of the original bracket sequence, which are regular bracket sequences.A bracket sequence is called regular if it is possible to obtain correct arithmetic expression by inserting characters "+" and "1" into this sequence. For example, sequences "(())()", "()" and "(()(()))" are regular, while ")(", "(()" and "(()))(" are not.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 1000)$$$, the size of the compressed sequence. The second line contains a sequence of integers $$$c_1, c_2, \dots, c_n$$$ $$$(1 \le c_i \le 10^9)$$$, the compressed sequence.

Output a single integer — the total number of subsegments of the original bracket sequence, which are regular bracket sequences. It can be proved that the answer fits in the signed 64-bit integer data type.

NoteIn the first example a sequence (((()(()))( is described. This bracket sequence contains $$$5$$$ subsegments which form regular bracket sequences:  Subsequence from the $$$3$$$rd to $$$10$$$th character: (()(()))  Subsequence from the $$$4$$$th to $$$5$$$th character: ()  Subsequence from the $$$4$$$th to $$$9$$$th character: ()(())  Subsequence from the $$$6$$$th to $$$9$$$th character: (())  Subsequence from the $$$7$$$th to $$$8$$$th character: () In the second example a sequence ()))(()(()))) is described.In the third example a sequence ()()(()) is described.

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

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

import Data.List
import Data.Int

solve :: [Int] -> Int64
solve = let
  pullStack :: [(Int64, Int)] -> Int64 -> Int64 -> (Int64, [(Int64, Int)])
  pullStack [] tar acc = (acc, [(tar, 0)])
  pullStack s@((psum, uses) : st) tar acc = case  compare psum tar  of
    LT -> (acc, (tar, 1) : s)
    EQ -> (acc + fromIntegral uses, (tar, uses + 1) : st)
    GT -> pullStack st tar (acc + fromIntegral uses)
  go :: [(Int64, Int)] -> Int64 -> Int64 -> [Int] -> Int64
  go stack !psum !acc (x : y : zs) = let
    nsum = psum + fromIntegral (x - y)
    (extra, nstack) = pullStack stack nsum 0
    nacc = acc + extra + fromIntegral y
    in  go nstack nsum nacc zs
  go [(worst, _ct)] _ acc _ = acc + worst
  go (_ : stack) _ps acc _ = go stack _ps acc []
  go [] _ _ _ = error "invariant failed"
  in  go [(0, 0)] 0 0

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n] <- getInts 1
  c <- getInts n
  putInt64s [solve c]

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

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

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

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'


A string is called beautiful if no two consecutive characters are equal. For example, "ababcb", "a" and "abab" are beautiful strings, while "aaaaaa", "abaa" and "bb" are not.Ahcl wants to construct a beautiful string. He has a string $$$s$$$, consisting of only characters 'a', 'b', 'c' and '?'. Ahcl needs to replace each character '?' with one of the three characters 'a', 'b' or 'c', such that the resulting string is beautiful. Please help him!More formally, after replacing all characters '?', the condition $$$s_i \neq s_{i+1}$$$ should be satisfied for all $$$1 \leq i \leq |s| - 1$$$, where $$$|s|$$$ is the length of the string $$$s$$$.

The first line contains positive integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. Next $$$t$$$ lines contain the descriptions of test cases. Each line contains a non-empty string $$$s$$$ consisting of only characters 'a', 'b', 'c' and '?'.  It is guaranteed that in each test case a string $$$s$$$ has at least one character '?'. The sum of lengths of strings $$$s$$$ in all test cases does not exceed $$$10^5$$$.

For each test case given in the input print the answer in the following format:   If it is impossible to create a beautiful string, print "-1" (without quotes);  Otherwise, print the resulting beautiful string after replacing all '?' characters. If there are multiple answers, you can print any of them.

NoteIn the first test case, all possible correct answers are "ababcb", "abcacb", "abcbcb", "acabcb" and "acbacb". The two answers "abcbab" and "abaabc" are incorrect, because you can replace only '?' characters and the resulting string must be beautiful.In the second test case, it is impossible to create a beautiful string, because the $$$4$$$-th and $$$5$$$-th characters will be always equal.In the third test case, the only answer is "acbac".

import Control.Monad

solveRecursively :: (Char,String) -> Maybe String
solveRecursively (prev,x:(x2:xs))
  |prev == x = Nothing
  |x=='?' = fmap ((:) (decide [prev,x2])) (solveRecursively (decide [prev,x2],x2:xs))
  |otherwise = fmap ((:) x) (solveRecursively (x,x2:xs))
solveRecursively (prev,[x])
  |prev == x = Nothing
  |x=='?' = fmap ((:) (decide [prev])) (solveRecursively (decide [prev],[]))
  |otherwise =fmap ((:) x) (solveRecursively (x,[]))
solveRecursively _ = Just []

routine :: IO ()
routine = do
  str <- getLine
  case solveRecursively ('y',str) of
    Nothing -> putStrLn "-1"
    Just x -> putStrLn x

decide :: [Char] -> Char
decide li = head $ filter (`notElem` li) "abc"

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

import Control.Monad

main :: IO ()
main = do
  input <- getLine
  let linesToRead = read input
  tryDecorateString linesToRead

tryDecorateString :: Int -> IO ()
tryDecorateString 0 = pure ()
tryDecorateString n = do
  currentLine <- getLine
  if isStringBeautiful currentLine Nothing
  then putStrLn (reverse (decorateString currentLine []))
  else putStrLn "-1"
  tryDecorateString (n - 1)

alphabet :: [Char]
alphabet = ['a', 'b', 'c']

-- check that string doesn't contains any double characters
isStringBeautiful :: [Char] -> Maybe Char -> Bool
isStringBeautiful (x:xs) Nothing =
  if (length xs) == 0
  then True
  else isStringBeautiful xs (Just x)

isStringBeautiful (x:xs) (Just prevChar) =
  if x == prevChar && x /= '?'
  then False
  else isStringBeautiful xs (Just x)

isStringBeautiful [] _ = True

-- start for 1 elem
decorateString :: [Char] -> [Char] -> [Char]
decorateString word formattedWord =
  case word of
  (x:[]) -> case x of
    '?' -> case formattedWord of
      -- start iteration
      [] -> [anyChar]
      -- end of iteration
      (r:rs) -> allowedEnd:r:rs
    _ -> x:formattedWord
  (x:xs) -> case x of
    '?' -> case formattedWord of
      [] -> decorateString xs (allowedStart:[])
      (r:rs) -> decorateString xs (allowedMiddle:r:rs)
    _   -> decorateString xs (x:formattedWord)
  where
    anyChar = alphabet !! 0
    nextChar = word !! 1
    prevChar = head formattedWord
    allowedStart = (filter (/= nextChar) alphabet) !! 0
    allowedMiddle = (filter (\x -> x /= prevChar && x /= nextChar) alphabet) !! 0
    allowedEnd = (filter (/= prevChar) alphabet) !! 0

-- beautify string

tests :: [String]
tests = ["a???cb", "a??bbc", "a?b?c", "a??a"]

import Control.Monad

solve :: String -> String
solve str = newStr
  where
    indexed = zip [0..] str
    newStr = map f indexed
    f (index,char)
      | char /= '?' = char
      | index ==0 = decide [str!!(index+1)]
      | index ==length str-1 = decide [newStr!!(index-1)]
      | otherwise = decide [newStr!!(index-1),str!!(index+1)]

decide :: [Char] -> Char
decide li = head $ filter (`notElem` li) "abc"

routine :: IO ()
routine = do
  str <- getLine
  putStrLn $ solve str

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

import Control.Monad

main :: IO ()
main = do
  input <- getLine
  let linesToRead = read input
  tryDecorateString linesToRead

tryDecorateString :: Int -> IO ()
tryDecorateString 0 = pure ()
tryDecorateString n = do
  currentLine <- getLine
  if isStringBeautiful currentLine Nothing
  then putStrLn (decorateString currentLine [])
  else putStrLn "-1"
  tryDecorateString (n - 1)

alphabet :: [Char]
alphabet = ['a', 'b', 'c']

-- check that string doesn't contains any double characters
isStringBeautiful :: [Char] -> Maybe Char -> Bool
isStringBeautiful (x:xs) Nothing =
  if (length xs) == 0
  then True
  else isStringBeautiful xs (Just x)

isStringBeautiful (x:xs) (Just prevChar) =
  if x == prevChar && x /= '?'
  then False
  else isStringBeautiful xs (Just x)

isStringBeautiful [] _ = True

-- start for 1 elem
decorateString :: [Char] -> [Char] -> [Char]
decorateString word formattedWord =
  case word of
  (x:[]) -> case x of
    '?' -> case formattedWord of
      -- start iteration
      [] -> [anyChar]
      -- end of iteration
      (r:rs) -> allowedEnd:r:rs
    _ -> x:formattedWord
  (x:xs) -> case x of
    '?' -> case formattedWord of
      [] -> decorateString xs (allowedStart:[])
      (r:rs) -> decorateString xs (allowedMiddle:r:rs)
    _   -> decorateString xs (x:formattedWord)
  where
    anyChar = alphabet !! 0
    nextChar = word !! 1
    prevChar = head formattedWord
    allowedStart = (filter (/= nextChar) alphabet) !! 0
    allowedMiddle = (filter (\x -> x /= prevChar && x /= nextChar) alphabet) !! 0
    allowedEnd = (filter (/= prevChar) alphabet) !! 0

-- beautify string

tests :: [String]
tests = ["a???cb", "a??bbc", "a?b?c", "a??a"]


Alex was programming while Valentina (his toddler daughter) got there and started asking many questions about the round brackets (or parenthesis) in the code. He explained her a bit and when she got it he gave her a task in order to finish his code on time.For the purpose of this problem we consider only strings consisting of opening and closing round brackets, that is characters '(' and ')'.The sequence of brackets is called correct if:   it's empty;  it's a correct sequence of brackets, enclosed in a pair of opening and closing brackets;  it's a concatenation of two correct sequences of brackets. For example, the sequences "()()" and "((()))(())" are correct, while ")(()", "(((((" and "())" are not.Alex took a piece of paper, wrote a string s consisting of brackets and asked Valentina to count the number of distinct non-empty substrings of s that are correct sequences of brackets. In other words, her task is to count the number of non-empty correct sequences of brackets that occur in a string s as a substring (don't mix up with subsequences).When Valentina finished the task, Alex noticed he doesn't know the answer. Help him don't loose face in front of Valentina and solve the problem!

The first line of the input contains an integer n (1 ≤ n ≤ 500 000) — the length of the string s. The second line contains a string s of length n consisting of only '(' and ')'.

Print the number of distinct non-empty correct sequences that occur in s as substring.

NoteIn the first sample, there are 5 distinct substrings we should count: "()", "()()", "()()()", "()()()()" and "()()()()()".In the second sample, there are 3 distinct substrings we should count: "()", "(())" and "(())()".

{-# LANGUAGE Safe #-}
{-# LANGUAGE BangPatterns, FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Applicative
import Control.Monad.Identity hiding (forM_)
import Control.Monad.State.Strict hiding (forM_)
import Data.Array.IO.Safe
import Data.Foldable
import Data.Functor
import Data.Int
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map.Strict as M
import Text.Printf

-- | Backport

modify' :: MonadState s m => (s -> s) -> m ()
modify' f = do
    s <- get
    put $! f s

a & f = f a
infixl 1 &

-- | Lens

type ASetter s t a b = (a -> Identity b) -> s -> Identity t
_1 f (a, b) = (\a' -> (a', b)) <$> f a
_2 f (a, b) = (\b' -> (a, b')) <$> f b

(%~) :: ASetter s t a b -> (a -> b) -> s -> t
l %~ f = runIdentity . l (Identity . f)
infixr 4 %~

(.~) :: ASetter s t a b -> b -> s -> t
l .~ b = l %~ const b
infixr 4 .~

(+~) :: Num a => ASetter s t a a -> a -> s -> t
l +~ a = l %~ (+a)
infixr 4 +~

type Getting r s a = (a -> Const r a) -> s -> Const r s
(^.) :: s -> Getting a s a -> a
x ^. l = getConst $ l Const x
infixl 8 ^.

-- | Suffix automaton (multi-string)

data S = S {_no, _len :: !Int, _link :: Int, _next :: M.Map Int Int} deriving (Show)
no f s = (\a -> s {_no = a}) <$> f (_no s)
len f s = (\a -> s {_len = a}) <$> f (_len s)
link f s = (\a -> s {_link = a}) <$> f (_link s)
next f s = (\a -> s {_next = a}) <$> f (_next s)

emptyS = S {_no = 0, _len = 0, _link = -1, _next = M.empty}

insertS c p s = s {_next = M.insert c p (s ^. next)}

data SuffixAutomaton = SuffixAutomaton {_allo :: !Int, _lastS :: S, _states :: IOArray Int S}
allo f s = (\a -> s {_allo = a}) <$> f (_allo s)
lastS f s = (\a -> s {_lastS = a}) <$> f (_lastS s)
states f s = (\a -> s {_states = a}) <$> f (_states s)

root sam = liftIO $ readArray (sam^.states) 0

type MS = (SuffixAutomaton, Int64)

insertSAM :: (Functor m, MonadIO m, MonadState MS m) => S -> m ()
insertSAM p = do
  sam <- (^. _1) <$> get
  liftIO $ writeArray (sam^.states) (p^.no) p

computeLink :: (Functor m, MonadIO m, MonadState MS m) => S -> Int -> m S
computeLink p c = do
  sam <- (^. _1) <$> get
  let sts = sam^.states
  q <- liftIO $ readArray sts ((p^.next) M.! c)
  if p^.len + 1 == q^.len
     then return q
     else do
       let r = q & no .~ sam^.allo & len .~ p^.len + 1
           go p
             | Just t <- M.lookup c (p^.next) =
               when (t == q^.no) $ do
                 insertSAM $ insertS c (r^.no) p
                 case p^.link of
                      -1 -> return ()
                      p' -> liftIO (readArray sts p') >>= go
             | otherwise = return ()
       modify' . (_1 %~) $ \sam -> sam & allo +~ 1
       insertSAM r
       insertSAM $ q & link .~ r^.no
       go p
       return r

add :: (Functor m, MonadIO m, MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  sam <- (^. _1) <$> get
  let p = sam^.lastS
  if M.member c (p^.next)
    then do
      r <- computeLink p c
      modify' . (_1 %~) $ \sam -> sam & lastS .~ r
    else mdo
      let r = S {_no = sam^.allo, _len = p^.len + 1, _link = rl^.no, _next = M.empty}
      modify' . (_1 %~) $ \sam -> sam {_allo = sam^.allo + 1, _lastS = r}
      insertSAM r
      let go p
            | M.notMember c (p^.next) = do
                insertSAM $ insertS c (r^.no) p
                case p^.link of
                    -1 -> return Nothing
                    p' -> liftIO (readArray (sam^.states) p') >>= go
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (root sam) (`computeLink` c) q
      modify' $ _2 %~ (+ (fromIntegral $ r^.len - rl^.len))

end :: (Functor m, MonadIO m, MonadState MS m) => m Int
end = do
  sam <- (^. _1) <$> get
  rt <- root sam
  modify' $ (_1 . lastS) .~ rt
  return $ sam^.lastS^.no

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  child <- newArray (0, n) (-1) :: IO (IOUArray Int Int)
  sibling <- newArray_ (0, n-1) :: IO (IOUArray Int Int)
  char <- newArray_ (0, n-1) :: IO (IOUArray Int Int)
  sts <- newArray (0, 2*n-2) emptyS :: IO (IOArray Int S)
  let emptySAM = SuffixAutomaton {_allo = 1, _lastS = emptyS, _states = sts}
  let f o i
       | i == n = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           addSubs o
           e <- end
           when (o > 0) . lift $ do
             pos <- readArray child $ o-1
             writeArray child (o-1) i
             writeArray char i e
             writeArray sibling i pos
           f (max 0 $ o-1) (i+1)
      g pos
       | pos < 0 = return ()
       | otherwise = do
           c <- lift $ readArray char pos
           add c
           pos' <- lift $ readArray sibling pos
           g pos'
      addSubs o = do
        pos <- lift $ readArray child o
        lift $ writeArray child o (-1)
        g pos
  (sam, ans) <- flip execStateT (emptySAM, 0) $ do
    o <- f 0 0
    forM_ [o,o-1..0] $ \o -> do
      addSubs o
      void end
  print ans

{-# LANGUAGE FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Applicative
import Control.Monad.Identity hiding (forM_)
import Control.Monad.State hiding (forM_)
import Data.Foldable
import Data.Functor
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

-- | Lens

a & f = f a
infixl 1 &

type ASetter s t a b = (a -> Identity b) -> s -> Identity t
_1 f (a, b, c) = (\a' -> (a', b, c)) <$> f a
_2 f (a, b, c) = (\b' -> (a, b', c)) <$> f b
_3 f (a, b, c) = (\c' -> (a, b, c')) <$> f c

(%~) :: ASetter s t a b -> (a -> b) -> s -> t
l %~ f = runIdentity . l (Identity . f)
infixr 4 %~

(.~) :: ASetter s t a b -> b -> s -> t
l .~ b = l %~ const b
infixr 4 .~

(+~) :: Num a => ASetter s t a a -> a -> s -> t
l +~ a = l %~ (+a)
infixr 4 +~

type Getting r s a = (a -> Const r a) -> s -> Const r s
(^.) :: s -> Getting a s a -> a
x ^. l = getConst $ l Const x
infixl 8 ^.

-- | Suffix automaton (multi-string)

data S = S {_no, _len :: !Int, _link :: Int, _next :: M.Map Int Int} deriving (Show)
no f s = (\a -> s {_no = a}) <$> f (_no s)
len f s = (\a -> s {_len = a}) <$> f (_len s)
link f s = (\a -> s {_link = a}) <$> f (_link s)
next f s = (\a -> s {_next = a}) <$> f (_next s)

emptyS = S {_no = 0, _len = 0, _link = -1, _next = M.empty}

insertS c p s = s {_next = M.insert c p (s ^. next)}

data SuffixAutomaton = SuffixAutomaton {_allo :: !Int, _lastS :: S, _states :: M.Map Int S} deriving (Show)
allo f s = (\a -> s {_allo = a}) <$> f (_allo s)
lastS f s = (\a -> s {_lastS = a}) <$> f (_lastS s)
states f s = (\a -> s {_states = a}) <$> f (_states s)

emptySAM = SuffixAutomaton {_allo = 1, _lastS = emptyS, _states = M.singleton 0 emptyS}

root sam = (sam^.states) M.! 0

type MS = (SuffixAutomaton, Int, M.Map Int [Int])

insertSAM :: MonadState MS m => S -> m ()
insertSAM p = modify $ (_1 . states) %~ M.insert (p^.no) p

computeLink :: (Functor m, MonadState MS m) => S -> Int -> m S
computeLink p c = do
  sam <- (^. _1) <$> get
  let q = (sam^.states) M.! ((p^.next) M.! c)
  if p^.len + 1 == q^.len
     then return q
     else do
       let r = q & no .~ sam^.allo & len .~ p^.len + 1
       --let r = q {_no = _allo + 1, _len = p^.len + 1}
           go p
             | Just t <- M.lookup c (p^.next) =
               when (t == q^.no) $ do
                 insertSAM $ insertS c (r^.no) p
                 case p^.link of
                      -1 -> return ()
                      p' -> go $ (sam^.states) M.! p'
             | otherwise = return ()
       modify . (_1 %~) $ \sam -> sam & allo +~ 1
       insertSAM r
       --insertSAM q {link = no r}
       insertSAM $ q & link .~ r^.no
       go p
       return r

add :: (Functor m, MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  sam <- (^. _1) <$> get
  let p = sam^.lastS
  if M.member c (p^.next)
    then do
      r <- computeLink p c
      modify . (_1 %~) $ \sam -> sam & lastS .~ r
    else mdo
      let r = S {_no = sam^.allo, _len = p^.len + 1, _link = rl^.no, _next = M.empty}
      modify . (_1 %~) $ \sam -> sam {_allo = sam^.allo + 1, _lastS = r}
      insertSAM r
      let go p
            | M.notMember c (p^.next) = do
                insertSAM $ insertS c (r^.no) p
                case p^.link of
                    -1 -> return Nothing
                    p' -> go $ (sam^.states) M.! p'
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (return $ root sam) (`computeLink` c) q
      modify $ _2 %~ (+ (r^.len - rl^.len))

end :: (Functor m, MonadState MS m) => m Int
end = do
  sam <- (^. _1) <$> get
  modify $ (_1 . lastS) .~ root sam
  return $ sam^.lastS^.no

dump :: MonadIO m => SuffixAutomaton -> m ()
dump sam = liftIO $ do
  printf "Last %d\n" (sam ^. lastS ^. no)
  printf "N %d\n" (M.size $ sam^.states)
  f 0 ((sam^.states) M.! 0)
  where
    f d s = do
      putStr $ replicate (2*d) ' '
      printf "state %d len=%d link=%d (%d ch)\n" (s^.no) (s^.len) (s^.link) (M.size $ s^.next)
      forM_ (M.toList (s^.next)) $ \(c,x) -> do
        putStr $ replicate (2*d+2) ' '
        printf "%d ->\n" c
        if M.member x (sam^.states)
           then f (d+1) ((sam^.states) M.! x)
           else do
             putStr $ replicate (2*d+2) ' '
             printf "%d not found\n" x

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  let f o i
       | i == n = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           (_, _, child) <- get
           let cs = fromMaybe [] $ M.lookup o child
           forM_ cs add
           modify . (_3 %~) $ M.insert o []
           e <- end
           when (o > 0) $ do
             let cs = fromMaybe [] $ M.lookup (o-1) child
             modify . (_3 %~) $ M.insert (o-1) (e:cs)
           f (max 0 $ o-1) (i+1)
  (sam, ans, child) <- flip execStateT (emptySAM, 0, M.empty) $ do
    o <- f 0 0
    child <- (^. _3) <$> get
    forM_ [o,o-1..0] $ \o -> do
      let cs = fromMaybe [] $ M.lookup o child
      forM_ cs add
      void end
  print ans
  --dump sam

{-# LANGUAGE FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Monad.State hiding (forM_)
import Data.Foldable
import Data.Functor
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

_1 f (a, b, c) = (f a, b, c)
_2 f (a, b, c) = (a, f b, c)
_3 f (a, b, c) = (a, b, f c)

data S = S {no, len :: !Int, link :: Int, next :: M.Map Int Int} deriving (Show)

emptyS = S {no = 0, len = 0, link = -1, next = M.empty}

insertS c p s = s {next = M.insert c p (next s)}

data SuffixAutomaton = SuffixAutomaton {allo :: Int, lastS :: S, states :: M.Map Int S} deriving (Show)

emptySAM = SuffixAutomaton {allo = 1, lastS = emptyS, states = M.singleton 0 emptyS}

root sam = states sam M.! 0

type MS = (SuffixAutomaton, Int, M.Map Int [Int])

insertSAM :: MonadState MS m => S -> m ()
insertSAM p = modify . _1 $ \sam -> sam {states = M.insert (no p) p (states sam)}

computeLink :: MonadState MS m => S -> Int -> m S
computeLink p c = do
  (sam@SuffixAutomaton{..}, _, _) <- get
  let q = states M.! (next p M.! c)
  if len p + 1 == len q
     then return q
     else do
       let r = q {no = allo + 1, len = len p + 1}
           go p
             | Just t <- M.lookup c (next p) =
               when (t == no q) $ do
                 insertSAM $ insertS c (no r) p
                 case M.lookup c $ next p of
                       Nothing -> return ()
                       Just p' -> go $ states M.! p'
             | otherwise = return ()
       modify . _1 $ \sam -> sam {allo = allo + 1}
       go p
       insertSAM q {link = no r}
       return r

add :: (MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  (sam, _, _) <- get
  let p = lastS sam
  if M.member c (next p)
    then do
      r <- computeLink p c
      modify . _1 $ \sam -> sam {lastS = r}
    else mdo
      let r = S {no = allo sam, len = len p + 1, link = no rl, next = M.empty}
      modify . _1 $ \sam -> sam {allo = allo sam + 1, lastS = r}
      insertSAM r
      let go p
            | M.notMember c (next p) = do
                insertSAM $ insertS c (no r) p
                case link p of
                    -1 -> return Nothing
                    p' -> go $ states sam M.! p'
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (return $ root sam) (`computeLink` c) q
      modify $ _2 (+ (len r - len rl))

end :: MonadState MS m => m Int
end = do
  (sam, ans, child) <- get
  put (sam {lastS = root sam}, ans, child)
  return . no $ lastS sam

dump :: SuffixAutomaton -> IO ()
dump sam = do
  printf "Last %d\n" (no $ lastS sam)
  printf "N %d\n" (M.size $ states sam)
  f 0 (states sam M.! 0)
  where
    f d s = do
      putStr $ replicate (2*d) ' '
      printf "state %d len=%d link=%d (%d ch)\n" (no s) (len s) (link s) (M.size $ next s)
      forM_ (M.toList (next s)) $ \(c,x) -> do
        putStr $ replicate (2*d+2) ' '
        printf "%d ->\n" c
        f (d+1) (states sam M.! x)

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  let f o i
       | i == B.length a = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           (_, _, child) <- get
           let cs = fromMaybe [] $ M.lookup o child
           forM_ cs add
           modify . _3 $ M.insert o []
           e <- end
           when (o > 0) $ do
             let cs = fromMaybe [] $ M.lookup (o-1) child
             modify . _3 $ M.insert (o-1) (e:cs)
           f (max 0 $ o-1) (i+1)
  (sam, ans, child) <- flip execStateT (emptySAM, 0, M.empty) $ do
    o <- f 0 0
    (_, _, child) <- get
    forM_ [o,o-1..0] $ \o -> do
      let cs = fromMaybe [] $ M.lookup o child
      forM_ cs add
      void end
  print ans
  dump sam

{-# LANGUAGE FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Monad.State hiding (forM_)
import Data.Foldable
import Data.Functor
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

_1 f (a, b, c) = (f a, b, c)
_2 f (a, b, c) = (a, f b, c)
_3 f (a, b, c) = (a, b, f c)

data S = S {no, len :: !Int, link :: Int, next :: M.Map Int Int} deriving (Show)

emptyS = S {no = 0, len = 0, link = -1, next = M.empty}

insertS c p s = s {next = M.insert c p (next s)}

data SuffixAutomaton = SuffixAutomaton {allo :: Int, lastS :: S, states :: M.Map Int S} deriving (Show)

emptySAM = SuffixAutomaton {allo = 1, lastS = emptyS, states = M.singleton 0 emptyS}

root sam = states sam M.! 0

type MS = (SuffixAutomaton, Int, M.Map Int [Int])

insertSAM :: MonadState MS m => S -> m ()
insertSAM p = modify . _1 $ \sam -> sam {states = M.insert (no p) p (states sam)}

computeLink :: MonadState MS m => S -> Int -> m S
computeLink p c = do
  (sam@SuffixAutomaton{..}, _, _) <- get
  let q = states M.! (next p M.! c)
  if len p + 1 == len q
     then return q
     else do
       let r = q {no = allo + 1, len = len p + 1}
           go p
             | Just t <- M.lookup c (next p) =
               when (t == no q) $ do
                 insertSAM $ insertS c (no r) p
                 case M.lookup c $ next p of
                       Nothing -> return ()
                       Just p' -> go $ states M.! p'
             | otherwise = return ()
       modify . _1 $ \sam -> sam {allo = allo + 1}
       insertSAM r
       insertSAM q {link = no r}
       go p
       return r

add :: (MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  (sam, _, _) <- get
  let p = lastS sam
  if M.member c (next p)
    then do
      r <- computeLink p c
      modify . _1 $ \sam -> sam {lastS = r}
    else mdo
      let r = S {no = allo sam, len = len p + 1, link = no rl, next = M.empty}
      modify . _1 $ \sam -> sam {allo = allo sam + 1, lastS = r}
      insertSAM r
      let go p
            | M.notMember c (next p) = do
                insertSAM $ insertS c (no r) p
                case link p of
                    -1 -> return Nothing
                    p' -> go $ states sam M.! p'
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (return $ root sam) (`computeLink` c) q
      modify $ _2 (+ (len r - len rl))

end :: MonadState MS m => m Int
end = do
  (sam, ans, child) <- get
  put (sam {lastS = root sam}, ans, child)
  return . no $ lastS sam

dump :: MonadIO m => SuffixAutomaton -> m ()
dump sam = liftIO $ do
  printf "Last %d\n" (no $ lastS sam)
  printf "N %d\n" (M.size $ states sam)
  f 0 (states sam M.! 0)
  where
    f d s = do
      putStr $ replicate (2*d) ' '
      printf "state %d len=%d link=%d (%d ch)\n" (no s) (len s) (link s) (M.size $ next s)
      forM_ (M.toList (next s)) $ \(c,x) -> do
        putStr $ replicate (2*d+2) ' '
        printf "%d ->\n" c
        if M.member x (states sam)
           then f (d+1) (states sam M.! x)
           else do
             putStr $ replicate (2*d+2) ' '
             printf "%d not found\n" x

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  let f o i
       | i == n = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           (_, _, child) <- get
           let cs = fromMaybe [] $ M.lookup o child
           forM_ cs add
           modify . _3 $ M.insert o []
           e <- end
           when (o > 0) $ do
             let cs = fromMaybe [] $ M.lookup (o-1) child
             modify . _3 $ M.insert (o-1) (e:cs)
           f (max 0 $ o-1) (i+1)
  (sam, ans, child) <- flip execStateT (emptySAM, 0, M.empty) $ do
    o <- f 0 0
    (_, _, child) <- get
    forM_ [o,o-1..0] $ \o -> do
      let cs = fromMaybe [] $ M.lookup o child
      forM_ cs add
      void end
  print ans
  --dump sam

{-# LANGUAGE FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Monad.State hiding (forM_)
import Data.Foldable
import Data.Functor
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

_1 f (a, b, c) = (f a, b, c)
_2 f (a, b, c) = (a, f b, c)
_3 f (a, b, c) = (a, b, f c)

data S = S {no, len :: !Int, link :: Int, next :: M.Map Int Int} deriving (Show)

emptyS = S {no = 0, len = 0, link = -1, next = M.empty}

insertS c p s = s {next = M.insert c p (next s)}

data SuffixAutomaton = SuffixAutomaton {allo :: Int, lastS :: S, states :: M.Map Int S} deriving (Show)

emptySAM = SuffixAutomaton {allo = 1, lastS = emptyS, states = M.singleton 0 emptyS}

root sam = states sam M.! 0

type MS = (SuffixAutomaton, Int, M.Map Int [Int])

insertSAM :: MonadState MS m => S -> m ()
insertSAM p = modify . _1 $ \sam -> sam {states = M.insert (no p) p (states sam)}

computeLink :: MonadState MS m => S -> Int -> m S
computeLink p c = do
  (sam@SuffixAutomaton{..}, _, _) <- get
  let q = states M.! (next p M.! c)
  if len p + 1 == len q
     then return q
     else do
       let r = q {no = allo + 1, len = len p + 1}
           go p
             | Just t <- M.lookup c (next p) =
               when (t == no q) $ do
                 insertSAM $ insertS c (no r) p
                 case M.lookup c $ next p of
                       Nothing -> return ()
                       Just p' -> go $ states M.! p'
             | otherwise = return ()
       modify . _1 $ \sam -> sam {allo = allo + 1}
       go p
       insertSAM q {link = no r}
       return r

add :: (MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  (sam, _, _) <- get
  let p = lastS sam
  if M.member c (next p)
    then do
      r <- computeLink p c
      modify . _1 $ \sam -> sam {lastS = r}
    else mdo
      let r = S {no = allo sam, len = len p + 1, link = no rl, next = M.empty}
      modify . _1 $ \sam -> sam {allo = allo sam + 1, lastS = r}
      insertSAM r
      let go p
            | M.notMember c (next p) = do
                insertSAM $ insertS c (no r) p
                case link p of
                    -1 -> return Nothing
                    p' -> go $ states sam M.! p'
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (return $ root sam) (`computeLink` c) q
      modify $ _2 (+ (len r - len rl))

end :: MonadState MS m => m Int
end = do
  (sam, ans, child) <- get
  put (sam {lastS = root sam}, ans, child)
  return . no $ lastS sam

dump :: SuffixAutomaton -> IO ()
dump sam = do
  printf "Last %d\n" (no $ lastS sam)
  printf "N %d\n" (M.size $ states sam)
  f 0 (states sam M.! 0)
  where
    f d s = do
      putStr $ replicate (2*d) ' '
      printf "state %d len=%d link=%d (%d ch)\n" (no s) (len s) (link s) (M.size $ next s)
      forM_ (M.toList (next s)) $ \(c,x) -> do
        putStr $ replicate (2*d+2) ' '
        printf "%d ->\n" c
        f (d+1) (states sam M.! x)

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  let f o i
       | i == B.length a = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           (_, _, child) <- get
           let cs = fromMaybe [] $ M.lookup o child
           forM_ cs add
           modify . _3 $ M.insert o []
           e <- end
           when (o > 0) $ do
             let cs = fromMaybe [] $ M.lookup (o-1) child
             modify . _3 $ M.insert (o-1) (e:cs)
           f (o-1) (i+1)
  (sam, ans, child) <- flip execStateT (emptySAM, 0, M.empty) $ do
    o <- f 0 0
    (_, _, child) <- get
    forM_ [o,o-1..0] $ \o -> do
      let cs = fromMaybe [] $ M.lookup o child
      forM_ cs add
      void end
  print ans
  --dump sam

{-# LANGUAGE FlexibleContexts, RecordWildCards, RecursiveDo #-}
import Control.Monad.State hiding (forM_)
import Data.Foldable
import Data.Functor
import Data.List hiding (foldl')
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

_1 f (a, b, c) = (f a, b, c)
_2 f (a, b, c) = (a, f b, c)
_3 f (a, b, c) = (a, b, f c)

data S = S {no, len :: !Int, link :: Int, next :: M.Map Int Int} deriving (Show)

emptyS = S {no = 0, len = 0, link = -1, next = M.empty}

insertS c p s = s {next = M.insert c p (next s)}

data SuffixAutomaton = SuffixAutomaton {allo :: Int, lastS :: S, states :: M.Map Int S} deriving (Show)

emptySAM = SuffixAutomaton {allo = 1, lastS = emptyS, states = M.singleton 0 emptyS}

root sam = states sam M.! 0

type MS = (SuffixAutomaton, Int, M.Map Int [Int])

insertSAM :: MonadState MS m => S -> m ()
insertSAM p = modify . _1 $ \sam -> sam {states = M.insert (no p) p (states sam)}

computeLink :: MonadState MS m => S -> Int -> m S
computeLink p c = do
  (sam@SuffixAutomaton{..}, _, _) <- get
  let q = states M.! (next p M.! c)
  if len p + 1 == len q
     then return q
     else do
       let r = q {no = allo + 1, len = len p + 1}
           go p
             | Just t <- M.lookup c (next p) =
               when (t == no q) $ do
                 insertSAM $ insertS c (no r) p
                 case M.lookup c $ next p of
                       Nothing -> return ()
                       Just p' -> go $ states M.! p'
             | otherwise = return ()
       modify . _1 $ \sam -> sam {allo = allo + 1}
       go p
       insertSAM q {link = no r}
       return r

add :: (MonadFix m, MonadState MS m) => Int -> m ()
add c = do
  (sam, _, _) <- get
  let p = lastS sam
  if M.member c (next p)
    then do
      r <- computeLink p c
      modify . _1 $ \sam -> sam {lastS = r}
    else mdo
      let r = S {no = allo sam, len = len p + 1, link = no rl, next = M.empty}
      modify . _1 $ \sam -> sam {allo = allo sam + 1, lastS = r}
      insertSAM r
      let go p
            | M.notMember c (next p) = do
                insertSAM $ insertS c (no r) p
                case link p of
                    -1 -> return Nothing
                    p' -> go $ states sam M.! p'
            | otherwise = return $ Just p
      q <- go p
      rl <- maybe (return $ root sam) (`computeLink` c) q
      modify $ _2 (+ (len r - len rl))

end :: MonadState MS m => m Int
end = do
  (sam, ans, child) <- get
  put (sam {lastS = root sam}, ans, child)
  return . no $ lastS sam

dump :: SuffixAutomaton -> IO ()
dump sam = do
  printf "Last %d\n" (no $ lastS sam)
  printf "N %d\n" (M.size $ states sam)
  f 0 (states sam M.! 0)
  where
    f d s = do
      putStr $ replicate (2*d) ' '
      printf "state %d len=%d link=%d (%d ch)\n" (no s) (len s) (link s) (M.size $ next s)
      forM_ (M.toList (next s)) $ \(c,x) -> do
        putStr $ replicate (2*d+2) ' '
        printf "%d ->\n" c
        f (d+1) (states sam M.! x)

main = do
  n <- (fst . fromJust . B.readInt) <$> B.getLine
  a <- B.getLine
  let f o i
       | i == B.length a = return o
       | B.index a i == '(' =
           f (o+1) (i+1)
       | otherwise = do
           (_, _, child) <- get
           let cs = fromMaybe [] $ M.lookup o child
           forM_ cs add
           modify . _3 $ M.insert o []
           e <- end
           when (o > 0) $ do
             let cs = fromMaybe [] $ M.lookup (o-1) child
             modify . _3 $ M.insert (o-1) (e:cs)
           f (max 0 $ o-1) (i+1)
  (sam, ans, child) <- flip execStateT (emptySAM, 0, M.empty) $ do
    o <- f 0 0
    (_, _, child) <- get
    forM_ [o,o-1..0] $ \o -> do
      let cs = fromMaybe [] $ M.lookup o child
      forM_ cs add
      void end
  print ans
  --dump sam