Recently, you found a bot to play "Rock paper scissors" with. Unfortunately, the bot uses quite a simple algorithm to play: he has a string $$$s = s_1 s_2 \dots s_{n}$$$ of length $$$n$$$ where each letter is either R, S or P.While initializing, the bot is choosing a starting index $$$pos$$$ ($$$1 \le pos \le n$$$), and then it can play any number of rounds. In the first round, he chooses "Rock", "Scissors" or "Paper" based on the value of $$$s_{pos}$$$:   if $$$s_{pos}$$$ is equal to R the bot chooses "Rock";  if $$$s_{pos}$$$ is equal to S the bot chooses "Scissors";  if $$$s_{pos}$$$ is equal to P the bot chooses "Paper"; In the second round, the bot's choice is based on the value of $$$s_{pos + 1}$$$. In the third round — on $$$s_{pos + 2}$$$ and so on. After $$$s_n$$$ the bot returns to $$$s_1$$$ and continues his game.You plan to play $$$n$$$ rounds and you've already figured out the string $$$s$$$ but still don't know what is the starting index $$$pos$$$. But since the bot's tactic is so boring, you've decided to find $$$n$$$ choices to each round to maximize the average number of wins.In other words, let's suggest your choices are $$$c_1 c_2 \dots c_n$$$ and if the bot starts from index $$$pos$$$ then you'll win in $$$win(pos)$$$ rounds. Find $$$c_1 c_2 \dots c_n$$$ such that $$$\frac{win(1) + win(2) + \dots + win(n)}{n}$$$ is maximum possible.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain test cases — one per line. The first and only line of each test case contains string $$$s = s_1 s_2 \dots s_{n}$$$ ($$$1 \le n \le 2 \cdot 10^5$$$; $$$s_i \in \{\text{R}, \text{S}, \text{P}\}$$$) — the string of the bot. It's guaranteed that the total length of all strings in one test doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print $$$n$$$ choices $$$c_1 c_2 \dots c_n$$$ to maximize the average number of wins. Print them in the same manner as the string $$$s$$$. If there are multiple optimal answers, print any of them.

NoteIn the first test case, the bot (wherever it starts) will always choose "Rock", so we can always choose "Paper". So, in any case, we will win all $$$n = 4$$$ rounds, so the average is also equal to $$$4$$$.In the second test case:   if bot will start from $$$pos = 1$$$, then $$$(s_1, c_1)$$$ is draw, $$$(s_2, c_2)$$$ is draw and $$$(s_3, c_3)$$$ is draw, so $$$win(1) = 0$$$;  if bot will start from $$$pos = 2$$$, then $$$(s_2, c_1)$$$ is win, $$$(s_3, c_2)$$$ is win and $$$(s_1, c_3)$$$ is win, so $$$win(2) = 3$$$;  if bot will start from $$$pos = 3$$$, then $$$(s_3, c_1)$$$ is lose, $$$(s_1, c_2)$$$ is lose and $$$(s_2, c_3)$$$ is lose, so $$$win(3) = 0$$$;  The average is equal to $$$\frac{0 + 3 + 0}{3} = 1$$$ and it can be proven that it's the maximum possible average.A picture from Wikipedia explaining "Rock paper scissors" game:

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (xs : rest) = solve xs : process rest

solve :: String -> String
solve cs = take (length cs) $ repeat $ win $ snd $ last $ sort $ map (\xs-> (length xs, head xs)) $ group $ sort cs where
      win 'S' = 'R'
      win 'R' = 'P'
      win 'P' = 'S'

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

main = getLine >>= flip replicateM_ test . read

test = do
  s <- getLine
  putStrLn $ replicate (length s) $
    case head $ maximumBy (comparing length) $ group $ sort s of
      'R' -> 'P'
      'P' -> 'S'
      _ -> 'R'

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (xs : rest) = solve xs : process rest

solve :: String -> String
solve cs = take (length cs) $ repeat $ win $ fst $ last $ sort $ map (\xs-> (head xs, length xs)) $ group $ sort cs where
      win 'S' = 'R'
      win 'R' = 'P'
      win 'P' = 'S'


When Xellos was doing a practice course in university, he once had to measure the intensity of an effect that slowly approached equilibrium. A good way to determine the equilibrium intensity would be choosing a sufficiently large number of consecutive data points that seems as constant as possible and taking their average. Of course, with the usual sizes of data, it's nothing challenging — but why not make a similar programming contest problem while we're at it?You're given a sequence of n data points a1, ..., an. There aren't any big jumps between consecutive data points — for each 1 ≤ i < n, it's guaranteed that |ai + 1 - ai| ≤ 1.A range [l, r] of data points is said to be almost constant if the difference between the largest and the smallest value in that range is at most 1. Formally, let M be the maximum and m the minimum value of ai for l ≤ i ≤ r; the range [l, r] is almost constant if M - m ≤ 1.Find the length of the longest almost constant range.

The first line of the input contains a single integer n (2 ≤ n ≤ 100 000) — the number of data points. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 100 000).

Print a single number — the maximum length of an almost constant range of the given sequence.

NoteIn the first sample, the longest almost constant range is [2, 5]; its length (the number of data points in it) is 4.In the second sample, there are three almost constant ranges of length 4: [1, 4], [6, 9] and [7, 10]; the only almost constant range of the maximum length 5 is [6, 10].

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    ys = map (\g -> (head g, length g)) $ group xs

    (r0, k0, d0) = (ys2, length ys1, sum $ map snd ys1)
      where
        (ys1, ys2) = span (\x -> fst x == a || fst x == b) ys
        ((a, _):(b, _):_) = ys

    scan :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> Int
    scan [_] _ _ m = m
    scan _ [] _ m = m
    scan l r k m = scan l' r' k' $ max d' m
      where
        l' = drop (k-1) l
        (a, _) = head l'
        (b, _) = head r
        (r1, r') = span (\x -> fst x == a || fst x == b) r
        k' = 1 + length r1
        d' = snd (head l') + sum (map snd r1)

  print $ if length ys == 1 then snd $ head ys else scan ys r0 k0 d0

import Control.Applicative
import Debug.Trace

solve :: Int -> Int -> Int -> Int -> [Int] -> Int
solve _ cntp cntn ans [_] = max ans $ cntp + cntn
solve pre cntp cntn ans (x:y:ys)
    | x == y = trace (show $ cntp + cntn) $ solve pre cntp (cntn+1) ans (y:ys)
    | pre == 0 || pre == y = trace (show $ cntp + cntn) $ solve x (cntp+cntn) 1 ans (y:ys)
    | otherwise = trace (show $ cntp + cntn) $ solve x cntn 1 (max ans $ cntp+cntn) (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    as <- map read . words <$> getLine
    print $ solve 0 0 1 0 as

import Control.Applicative

solve :: Int -> Int -> Int -> Int -> [Int] -> Int
solve _ cntp cntn ans [_] = max ans $ cntp + cntn
solve pre cntp cntn ans (x:y:ys)
    | x == y = solve pre cntp (cntn+1) ans (y:ys)
    | pre == 0 || pre == y = solve x (cntp+cntn) 1 ans (y:ys)
    | otherwise = solve x cntn 1 (max ans $ cntp+cntn) (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    as <- map read . words <$> getLine
    print $ solve 0 0 0 0 as


Monocarp had a permutation $$$a$$$ of $$$n$$$ integers $$$1$$$, $$$2$$$, ..., $$$n$$$ (a permutation is an array where each element from $$$1$$$ to $$$n$$$ occurs exactly once).Then Monocarp calculated an array of integers $$$b$$$ of size $$$n$$$, where $$$b_i = \left\lfloor \frac{i}{a_i} \right\rfloor$$$. For example, if the permutation $$$a$$$ is $$$[2, 1, 4, 3]$$$, then the array $$$b$$$ is equal to $$$\left[ \left\lfloor \frac{1}{2} \right\rfloor, \left\lfloor \frac{2}{1} \right\rfloor, \left\lfloor \frac{3}{4} \right\rfloor, \left\lfloor \frac{4}{3} \right\rfloor \right] = [0, 2, 0, 1]$$$.Unfortunately, the Monocarp has lost his permutation, so he wants to restore it. Your task is to find a permutation $$$a$$$ that corresponds to the given array $$$b$$$. If there are multiple possible permutations, then print any of them. The tests are constructed in such a way that least one suitable permutation exists.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 5 \cdot 10^5$$$). The second line contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$0 \le b_i \le n$$$). Additional constrains on the input:   the sum of $$$n$$$ over test cases does not exceed $$$5 \cdot 10^5$$$;  there exists at least one permutation $$$a$$$ that would yield this array $$$b$$$.

For each test case, print $$$n$$$ integers — a permutation $$$a$$$ that corresponds to the given array $$$b$$$. If there are multiple possible permutations, then print any of them.

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

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> [Int]
solve n bs = as
    where
        as :: [Int]
        as = map snd . sort $ solve' 1 S.empty eventGroups

        aRanges :: [(Int, Int)]
        aRanges = do
            (i, b) <- zip [1 .. n] bs
            let l = i `div` (b + 1) + 1
            let r = if b == 0 then n else i `div` b
            return (l, r)

        eventGroups :: [[(Int, (Int, Int))]]
        eventGroups = buildEventGroups 1 . L.groupBy (\a b -> fst (snd a) == fst (snd b)) . sortOn snd $ zip [1 .. n] aRanges

        buildEventGroups :: Int -> [[(Int, (Int, Int))]] -> [[(Int, (Int, Int))]]
        buildEventGroups k _ | k > n = []
        buildEventGroups k [] = [] : buildEventGroups (k + 1) []
        buildEventGroups k eventGroups@(eventGroup : otherEventGroups)
            | k == (fst . snd $ head eventGroup) = eventGroup : buildEventGroups (k + 1) otherEventGroups
            | otherwise = [] : buildEventGroups (k + 1) eventGroups

        solve' :: Int -> S.Set (Int, Int) -> [[(Int, (Int, Int))]] -> [(Int, Int)]
        solve' _ rSet [] | S.size rSet == 0 = []
        solve' k rSet [] = (i, k) : solve' (k + 1) finalRSet []
            where
                ((r, i), finalRSet) = S.deleteFindMin rSet

        solve' k rSet eventGroups = (i, k) : solve' (k + 1) finalRSet (tail eventGroups)
            where
                events = head eventGroups
                newRSet = L.foldl' (\rSet (i, (_, r)) -> S.insert (r, i) rSet) rSet events
                ((r, i), finalRSet) = S.deleteFindMin newRSet

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

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

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x
--
-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> [Int]
solve n bs = as
    where
        as :: [Int]
        as = map snd . sort $ solve' 1 S.empty eventGroups

        aRanges :: [(Int, Int)]
        aRanges = do
            (i, b) <- zip [1 .. n] bs
            let l = i `div` (b + 1) + 1
            let r = if b == 0 then n else i `div` b
            return (l, r)

        eventGroups :: [[(Int, (Int, Int))]]
        eventGroups = L.groupBy (\a b -> (fst (snd a)) == (fst (snd b))) . sortOn snd $ zip [1 .. n] aRanges

        solve' :: Int -> S.Set (Int, Int) -> [[(Int, (Int, Int))]] -> [(Int, Int)]
        solve' _ rSet [] | S.size rSet == 0 = []
        solve' k rSet [] = (i, k) : solve' (k + 1) finalRSet []
            where
                ((r, i), finalRSet) = S.deleteFindMin rSet

        solve' k rSet eventGroups = (i, k) : solve' (k + 1) finalRSet (tail eventGroups)
            where
                events = head eventGroups
                newRSet = L.foldl' (\rSet (i, (_, r)) -> S.insert (r, i) rSet) rSet events
                ((r, i), finalRSet) = S.deleteFindMin newRSet

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


You are given an array a consisting of n elements. The imbalance value of some subsegment of this array is the difference between the maximum and minimum element from this segment. The imbalance value of the array is the sum of imbalance values of all subsegments of this array.For example, the imbalance value of array [1, 4, 1] is 9, because there are 6 different subsegments of this array:   [1] (from index 1 to index 1), imbalance value is 0;  [1, 4] (from index 1 to index 2), imbalance value is 3;  [1, 4, 1] (from index 1 to index 3), imbalance value is 3;  [4] (from index 2 to index 2), imbalance value is 0;  [4, 1] (from index 2 to index 3), imbalance value is 3;  [1] (from index 3 to index 3), imbalance value is 0; You have to determine the imbalance value of the array a.

The first line contains one integer n (1 ≤ n ≤ 106) — size of the array a. The second line contains n integers a1, a2... an (1 ≤ ai ≤ 106) — elements of the array.

Print one integer — the imbalance value of a.

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

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

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let ~(lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | Triple i' x' il' <- lts], Triple i x il:ges)) (0, [Triple 0 hi 0]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

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

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

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = sum $ snd $ mapAccumL (\s (i, x) -> let ~(lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (Triple i x il:ges, sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') | Triple i' x' il' <- lts])) [Triple 0 hi 0] (zip [1..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

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

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let (lts, ges@((il, _, _):_)) = span (\(_, x', _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | (i', x', il') <- lts], (i, x, il):ges)) (0, [(0, hi, 0)]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

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

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

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = sum $ snd $ mapAccumL (\s (i, x) -> let (lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (Triple i x il:ges, sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') | Triple i' x' il' <- lts])) [Triple 0 hi 0] (zip [1..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

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

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let (lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | Triple i' x' il' <- lts], Triple i x il:ges)) (0, [Triple 0 hi 0]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier !Int64  !Int64  !Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Int]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = let x' = fromIntegral x in case l of
    [] -> (acc + cx * x', [Tier x cx (x' * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x' + my, Tier x cx (x' * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int64 {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Int]->Int64
maxSums = go 1 0 [] where
  go _  acc _ [] = acc
  go cx acc l xs@(x: rest) = let x' = fromIntegral x in case l of
    [] -> go 1 (acc + cx * x') [Tier x cx (x' * cx)] rest
    Tier y cy my : ys
      | x >= y    -> go (cx + cy) acc ys xs
      | otherwise -> go 1 (acc + cx * x' + my) (Tier x cx (x' * cx + my) : l) rest

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier Int64 Int64 Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

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

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

solve xs = fin l1 r1 - fin l0 r0
  where
    n = length xs
    zs = zip [1..] xs
    rzs = reverse zs
    lo = 0
    hi = 10^(6 :: Int) + 1
    l0 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((> x) . snd) s in (a:s', head s')) [(0, lo)] zs
    r0 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((>= x) . snd) s in (a:s', head s')) [(n + 1, lo)] rzs
    l1 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((< x) . snd) s in (a:s', head s')) [(0, hi)] zs
    r1 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((<= x) . snd) s in (a:s', head s')) [(n + 1, hi)] rzs
    fin ls rs = sum $ zipWith (\(i, x) (l, r) -> x * (i - l) * (r - i)) zs $ zip ls rs

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

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

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

solve xs = fin l1 r1 - fin l0 r0
  where
    n = length xs
    zs = zip [1..] xs
    rzs = reverse zs
    lo = 0
    hi = 10^(6 :: Int) + 1
    l0 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((> x) . snd) s in (a:s', head s')) [(0, lo)] zs
    r0 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((>= x) . snd) s in (a:s', head s')) [(n + 1, lo)] rzs
    l1 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((< x) . snd) s in (a:s', head s')) [(0, hi)] zs
    r1 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((<= x) . snd) s in (a:s', head s')) [(n + 1, hi)] rzs
    fin ls rs = sum $ zipWith (\(i, x) (l, r) -> fromIntegral $ x * (i - l) * (r - i) :: Int64) zs $ zip ls rs

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List

getInts::IO [Integer]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Integer]->Integer
maxSums = fst. foldl' (next 1) initial where
  initial = (0, [])
  next cx u@(acc, (y, cy) : ys) x
    | x >= y    = next (cx + cy) (acc, ys) x
    | otherwise = (acc + cx * x + (cx * cy) * y, (x, cx) : (y, cy) : ys)
  next cx (acc, []) x =  (acc + cx * x, [(x, cx)])

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)


A binary string is a string consisting only of the characters 0 and 1. You are given a binary string $$$s$$$.For some non-empty substring$$$^\dagger$$$ $$$t$$$ of string $$$s$$$ containing $$$x$$$ characters 0 and $$$y$$$ characters 1, define its cost as:  $$$x \cdot y$$$, if $$$x > 0$$$ and $$$y > 0$$$;  $$$x^2$$$, if $$$x > 0$$$ and $$$y = 0$$$;  $$$y^2$$$, if $$$x = 0$$$ and $$$y > 0$$$. Given a binary string $$$s$$$ of length $$$n$$$, find the maximum cost across all its non-empty substrings.$$$^\dagger$$$ A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.

Each test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^5$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of the string $$$s$$$. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single integer — the maximum cost across all substrings.

NoteIn the first test case, we can take a substring $$$111$$$. It contains $$$3$$$ characters 1 and $$$0$$$ characters 0. So $$$a = 3$$$, $$$b = 0$$$ and its cost is $$$3^2 = 9$$$.In the second test case, we can take the whole string. It contains $$$4$$$ characters 1 and $$$3$$$ characters 0. So $$$a = 4$$$, $$$b = 3$$$ and its cost is $$$4 \cdot 3 = 12$$$.In the third test case, we can can take a substring $$$1111$$$ and its cost is $$$4^2 = 16$$$.In the fourth test case, we can take the whole string and cost is $$$4 \cdot 3 = 12$$$.In the fifth test case, we can take a substring $$$000$$$ and its cost is $$$3 \cdot 3 = 9$$$.In the sixth test case, we can only take the substring $$$0$$$ and its cost is $$$1 \cdot 1 = 1$$$.

-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import           Data.Ix                  (Ix)
import           Data.List                (group)
import           Debug.Trace              (trace)

solve :: String -> Int
solve str = max count (ind * ind)
  where
  x = length $ filter (=='0') str
  y = length $ filter (=='1') str
  count
    | x > 0 && y > 0 = x * y
    | x > 0 = x * x
    | otherwise = y * y
  ind = maximum $ length <$> group str

doCase :: IO ()
doCase = do
  _ <- getInt
  str <- getLine
  print $ solve str

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine


You are given two arrays $$$a$$$ and $$$b$$$, each consisting of $$$n$$$ positive integers, and an integer $$$x$$$. Please determine if one can rearrange the elements of $$$b$$$ so that $$$a_i + b_i \leq x$$$ holds for each $$$i$$$ ($$$1 \le i \le n$$$).

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. $$$t$$$ blocks follow, each describing an individual test case. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ ($$$1 \leq n \leq 50$$$; $$$1 \leq x \leq 1000$$$) — the length of arrays $$$a$$$ and $$$b$$$, and the parameter $$$x$$$, described in the problem statement. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_1 \le a_2 \le \dots \le a_n \leq x$$$) — the elements of array $$$a$$$ in non-descending order. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \leq b_1 \le b_2 \le \dots \le b_n \leq x$$$) — the elements of array $$$b$$$ in non-descending order. Test cases are separated by a blank line.

For each test case print Yes if one can rearrange the corresponding array $$$b$$$ so that $$$a_i + b_i \leq x$$$ holds for each $$$i$$$ ($$$1 \le i \le n$$$) or No otherwise. Each character can be printed in any case.

NoteIn the first test case, one can rearrange $$$b$$$ so it'll look like $$$[1, 2, 1]$$$. In this case, $$$1 + 1 \leq 4$$$; $$$2 + 2 \leq 4$$$; $$$3 + 1 \leq 4$$$.In the second test case, one can set $$$b$$$ to $$$[5, 2]$$$, then $$$1 + 5 \leq 6$$$; $$$4 + 2 \leq 6$$$.In the third test case, no matter how one shuffles array $$$b$$$, $$$a_4 + b_4 = 4 + b_4 > 4$$$.In the fourth test case, there is only one rearrangement of array $$$b$$$ and it doesn't satisfy the condition since $$$5 + 5 > 5$$$.

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (sort)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  filter (not . null) >>>
  map (words >>> map read) >>> process >>> map (bool "No" "Yes") >>> unlines

process :: [[Int]] -> [Bool]
process [] = []
process ([_, x]:xs:ys:xss) = solve x xs ys : process xss

solve :: Int -> [Int] -> [Int] -> Bool
solve x xs ys = all (<= x) $ zipWith (+) xs' ys'
  where
    xs' = sort xs
    ys' = reverse . sort $ ys

import System.IO
import Control.Monad
import Data.List

main :: IO ()
main = runNTestCases runTest

runTest :: IO ()
runTest = do
  (_, x) <- read2
  _a <- getLine
  _b <- getLine
  let a = (map read . words) _a
      b = (map read . words) _b
      ans = solve x a b
  putStrLn ans
  eof <- isEOF
  if eof
    then return ()
    else getLine >> return ()

solve :: Int -> [Int] -> [Int] -> String
solve x a b = if isImpossible x a b
              then "No"
              else "Yes"

isImpossible :: Int -> [Int] -> [Int] -> Bool
isImpossible x a b = any (\(_a, _b) -> _a + _b > x) $ zip (sort a) (reverse $ sort b)

runNTestCases :: IO () -> IO ()
runNTestCases f = do
  n <- read'
  replicateM_ n f

read' :: (Read a) => IO a
read' = do
  _ln <- getLine
  return (read _ln)

read2 :: (Read a) => IO (a, a)
read2 = do
  _ln <- getLine
  let [x1, x2] = (map read . words) _ln
  return (x1, x2)

module Main where

import Data.List
import Control.Monad

solveCase :: (Int, [Int], [Int]) -> Bool
solveCase (x, a, b) = all (<= x) $ zipWith (+) (sort a) (reverse $ sort b)

readCase :: IO (Int, [Int], [Int])
readCase = do
  [_, x] <- map read . words <$> getLine
  a <- map read . words <$> getLine
  b <- map read . words <$> getLine
  return (x, a, b)

main = do
  t <- read <$> getLine
  cases <- (:) <$> readCase <*> replicateM (t - 1) (getLine *> readCase)
  mapM_
    (\x ->
       putStrLn $
       if solveCase x
         then "Yes"
         else "No")
    cases

import qualified Data.Sequence as S

type Description = (Int, Int, [Int], [Int])

getTestDesc :: Bool -> IO Description
getTestDesc ign = do
  [n, x] <- getArr
  a <- getArr
  b <- getArr
  _ <- if ign then getLine else pure ""
  return (n, x, a, b)
  where getArr = getLine >>= pure . map read . words

solveTest :: Description -> String
solveTest (n, x, a, b) = if rz then "Yes" else "No"
  where seq c = S.sortBy c . S.fromList
	sa = seq compare a
	sb = seq (flip compare) b
	sz = S.zipWith (+) sa sb
	rz = foldl (&&) True . fmap (\u -> u <= x) $ sz

main :: IO ()
main = do
  t <- pure . read =<< getLine
  _ <- sequence $ replicate (t - 1) (getTestDesc True >>= putStrLn . solveTest)
  _ <- getTestDesc False >>= putStrLn . solveTest
  return ()


The Cartesian coordinate system is set in the sky. There you can see n stars, the i-th has coordinates (xi, yi), a maximum brightness c, equal for all stars, and an initial brightness si (0 ≤ si ≤ c).Over time the stars twinkle. At moment 0 the i-th star has brightness si. Let at moment t some star has brightness x. Then at moment (t + 1) this star will have brightness x + 1, if x + 1 ≤ c, and 0, otherwise.You want to look at the sky q times. In the i-th time you will look at the moment ti and you will see a rectangle with sides parallel to the coordinate axes, the lower left corner has coordinates (x1i, y1i) and the upper right — (x2i, y2i). For each view, you want to know the total brightness of the stars lying in the viewed rectangle.A star lies in a rectangle if it lies on its border or lies strictly inside it.

The first line contains three integers n, q, c (1 ≤ n, q ≤ 105, 1 ≤ c ≤ 10) — the number of the stars, the number of the views and the maximum brightness of the stars. The next n lines contain the stars description. The i-th from these lines contains three integers xi, yi, si (1 ≤ xi, yi ≤ 100, 0 ≤ si ≤ c ≤ 10) — the coordinates of i-th star and its initial brightness. The next q lines contain the views description. The i-th from these lines contains five integers ti, x1i, y1i, x2i, y2i (0 ≤ ti ≤ 109, 1 ≤ x1i < x2i ≤ 100, 1 ≤ y1i < y2i ≤ 100) — the moment of the i-th view and the coordinates of the viewed rectangle.

For each view print the total brightness of the viewed stars.

NoteLet's consider the first example.At the first view, you can see only the first star. At moment 2 its brightness is 3, so the answer is 3.At the second view, you can see only the second star. At moment 0 its brightness is 0, so the answer is 0.At the third view, you can see both stars. At moment 5 brightness of the first is 2, and brightness of the second is 1, so the answer is 3.

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

main = B.getContents >>= mapM_ print . fst . runState app . B.words

app = do
  ns <- nextI
  nv <- nextI
  m <- nextI
  ss <- replicateM ns $ (\x y s -> (s, x, y)) <$> nextI <*> nextI <*> nextI
  let m' = to64 m + 1
  let b = build ss
  replicateM nv $ (\t x1 y1 x2 y2 -> sum [(to64 t + to64 s) `rem` m' * to64 (b!(s, x2, y2) - b!(s, x1 - 1, y2) - b!(s, x2, y1 - 1) + b!(s, x1 - 1, y1 - 1)) | s <- [0..10]]) <$> nextI <*> nextI <*> nextI <*> nextI <*> nextI

build ss = b
  where
    bnd = ((0, 0, 0), (10, 100, 100))
    b0 = accumArray (+) 0 bnd $ zip ss (repeat 1) :: UArray (Int, Int, Int) Int
    b = listArray bnd $ map go $ range bnd :: Array (Int, Int, Int) Int
      where
        go (s, x, y)
          | x < 1 || y < 1 = b0!(s, x, y)
          | otherwise = b0!(s, x, y) + b!(s, x - 1, y) + b!(s, x, y - 1) - b!(s, x - 1, y - 1)

to64 x = fromIntegral x ::  Int64
next = state $ (\(x:xs) -> (x, xs))
nextI = fmap readInt next
readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


n fish, numbered from 1 to n, live in a lake. Every day right one pair of fish meet, and the probability of each other pair meeting is the same. If two fish with indexes i and j meet, the first will eat up the second with the probability aij, and the second will eat up the first with the probability aji = 1 - aij. The described process goes on until there are at least two fish in the lake. For each fish find out the probability that it will survive to be the last in the lake.

The first line contains integer n (1 ≤ n ≤ 18) — the amount of fish in the lake. Then there follow n lines with n real numbers each — matrix a. aij (0 ≤ aij ≤ 1) — the probability that fish with index i eats up fish with index j. It's guaranteed that the main diagonal contains zeros only, and for other elements the following is true: aij = 1 - aji. All real numbers are given with not more than 6 characters after the decimal point.

Output n space-separated real numbers accurate to not less than 6 decimal places. Number with index i should be equal to the probability that fish with index i will survive to be the last in the lake.

import Control.Monad
import Data.Array
import Data.Bits
import Data.List
import Text.Printf

getArray :: Read a => IO [a]
getArray = fmap (map read . words) getLine

gao :: Int -> [[Double]] -> [Double]
gao n a = [dp!bit i | i <- [0 .. n - 1]] where
	p = listArray ((0, 0), (n - 1, n - 1)) $ concat a
	dp = listArray (0::Int, bit n - 1) $ [dp' i | i <- [0::Int .. bit n - 2]] ++ [1.0]
	dp' m = sum [dp!setBit m j * p!(i,j) | i <- x, j <- y] / c where
		(x, y) = partition (testBit m) [0 .. n - 1]
		c = let lx = length x in fromIntegral $ div (lx * succ lx) 2

main = do
	[n] <- getArray
	a <- replicateM n getArray
	putStrLn $ unwords $ map (printf "%.6f") $ gao n a


Denis was very sad after Nastya rejected him. So he decided to walk through the gateways to have some fun. And luck smiled at him! When he entered the first courtyard, he met a strange man who was selling something. Denis bought a mysterious item and it was... Random permutation generator! Denis could not believed his luck.When he arrived home, he began to study how his generator works and learned the algorithm. The process of generating a permutation consists of $$$n$$$ steps. At the $$$i$$$-th step, a place is chosen for the number $$$i$$$ $$$(1 \leq i \leq n)$$$. The position for the number $$$i$$$ is defined as follows:  For all $$$j$$$ from $$$1$$$ to $$$n$$$, we calculate $$$r_j$$$  — the minimum index such that $$$j \leq r_j \leq n$$$, and the position $$$r_j$$$ is not yet occupied in the permutation. If there are no such positions, then we assume that the value of $$$r_j$$$ is not defined.  For all $$$t$$$ from $$$1$$$ to $$$n$$$, we calculate $$$count_t$$$  — the number of positions $$$1 \leq j \leq n$$$ such that $$$r_j$$$ is defined and $$$r_j = t$$$.  Consider the positions that are still not occupied by permutation and among those we consider the positions for which the value in the $$$count$$$ array is maximum.  The generator selects one of these positions for the number $$$i$$$. The generator can choose any position. Let's have a look at the operation of the algorithm in the following example:  Let $$$n = 5$$$ and the algorithm has already arranged the numbers $$$1, 2, 3$$$ in the permutation. Consider how the generator will choose a position for the number $$$4$$$:  The values of $$$r$$$ will be $$$r = [3, 3, 3, 4, \times]$$$, where $$$\times$$$ means an indefinite value.  Then the $$$count$$$ values will be $$$count = [0, 0, 3, 1, 0]$$$.  There are only two unoccupied positions in the permutation: $$$3$$$ and $$$4$$$. The value in the $$$count$$$ array for position $$$3$$$ is $$$3$$$, for position $$$4$$$ it is $$$1$$$.  The maximum value is reached only for position $$$3$$$, so the algorithm will uniquely select this position for number $$$4$$$. Satisfied with his purchase, Denis went home. For several days without a break, he generated permutations. He believes that he can come up with random permutations no worse than a generator. After that, he wrote out the first permutation that came to mind $$$p_1, p_2, \ldots, p_n$$$ and decided to find out if it could be obtained as a result of the generator.Unfortunately, this task was too difficult for him, and he asked you for help. It is necessary to define whether the written permutation could be obtained using the described algorithm if the generator always selects the position Denis needs.

The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^5)$$$  — the number of test cases. Then the descriptions of the test cases follow. The first line of the test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 10^5)$$$  — the size of the permutation. The second line of the test case contains $$$n$$$ different integers $$$p_1, p_2, \ldots, p_n$$$ ($$$1 \leq p_i \leq n$$$)  — the permutation written by Denis. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

Print "Yes" if this permutation could be obtained as a result of the generator. Otherwise, print "No". All letters can be displayed in any case.

NoteLet's simulate the operation of the generator in the first test.At the $$$1$$$ step, $$$r = [1, 2, 3, 4, 5], count = [1, 1, 1, 1, 1]$$$. The maximum value is reached in any free position, so the generator can choose a random position from $$$1$$$ to $$$5$$$. In our example, it chose $$$5$$$.At the $$$2$$$ step, $$$r = [1, 2, 3, 4, \times], count = [1, 1, 1, 1, 0]$$$. The maximum value is reached in positions from $$$1$$$ to $$$4$$$, so the generator can choose a random position among them. In our example, it chose $$$1$$$.At the $$$3$$$ step, $$$r = [2, 2, 3, 4, \times], count = [0, 2, 1, 1, 0]$$$. The maximum value is $$$2$$$ and is reached only at the $$$2$$$ position, so the generator will choose this position.At the $$$4$$$ step, $$$r = [3, 3, 3, 4, \times], count = [0, 0, 3, 1, 0]$$$. The maximum value is $$$3$$$ and is reached only at the $$$3$$$ position, so the generator will choose this position.At the $$$5$$$ step, $$$r = [4, 4, 4, 4, \times], count = [0, 0, 0, 4, 0]$$$. The maximum value is $$$4$$$ and is reached only at the $$$4$$$ position, so the generator will choose this position.In total, we got a permutation of $$$2, 3, 4, 5, 1$$$, that is, a generator could generate it.

import Control.Monad

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

routine :: IO ()
routine = do
    _ <- getLine
    as <- (map read.words) <$> getLine
    putStrLn $ if solve as
      then "Yes"
      else "No"

solve :: [Int] -> Bool
solve as = start (1,xs)
  where xs = reverse as

middle :: (Int,Int,Int,[Int]) -> Bool
middle (ziel,nächstesZiel,prev,x:xs)
  | prev==x+1 = if x == ziel
    then start (nächstesZiel,xs)
    else middle (ziel,nächstesZiel,x,xs)

  | otherwise = False
middle _ = undefined

start :: (Int,[Int]) -> Bool
start (altesZiel,x:xs)
  | altesZiel == x = start (x+1,xs)
  | otherwise = middle (altesZiel,x+1,x,xs)
start _ = True

valid :: [Int] -> Bool
valid [] = True
valid [_] = True
valid (a:b:ls)
    | b == a+1      = valid (b:ls)
    | b < a         = valid (b:ls)
    | otherwise     = False

parse :: String -> [Int]
parse = map read . words

solve :: [String] -> [String]
solve [] = []
solve (_:pLine:rest)
    | valid ps      = "YES": solve rest
    | otherwise     = "NO" : solve rest
    where
        ps = parse pLine

main :: IO ()
main = interact $ unlines . solve . tail . lines


Let's denote a $$$k$$$-step ladder as the following structure: exactly $$$k + 2$$$ wooden planks, of which  two planks of length at least $$$k+1$$$ — the base of the ladder;  $$$k$$$ planks of length at least $$$1$$$ — the steps of the ladder; Note that neither the base planks, nor the steps planks are required to be equal.For example, ladders $$$1$$$ and $$$3$$$ are correct $$$2$$$-step ladders and ladder $$$2$$$ is a correct $$$1$$$-step ladder. On the first picture the lengths of planks are $$$[3, 3]$$$ for the base and $$$[1]$$$ for the step. On the second picture lengths are $$$[3, 3]$$$ for the base and $$$[2]$$$ for the step. On the third picture lengths are $$$[3, 4]$$$ for the base and $$$[2, 3]$$$ for the steps.   You have $$$n$$$ planks. The length of the $$$i$$$-th planks is $$$a_i$$$. You don't have a saw, so you can't cut the planks you have. Though you have a hammer and nails, so you can assemble the improvised "ladder" from the planks.The question is: what is the maximum number $$$k$$$ such that you can choose some subset of the given planks and assemble a $$$k$$$-step ladder using them?

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of queries. The queries are independent. Each query consists of two lines. The first line contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of planks you have. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^5$$$) — the lengths of the corresponding planks. It's guaranteed that the total number of planks from all queries doesn't exceed $$$10^5$$$.

Print $$$T$$$ integers — one per query. The $$$i$$$-th integer is the maximum number $$$k$$$, such that you can choose some subset of the planks given in the $$$i$$$-th query and assemble a $$$k$$$-step ladder using them. Print $$$0$$$ if you can't make even $$$1$$$-step ladder from the given set of planks.

NoteExamples for the queries $$$1-3$$$ are shown at the image in the legend section.The Russian meme to express the quality of the ladders:

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    print $ min ((sort str !! (x - 2)) - 1) (x - 2)

import Data.Char
import System.IO

-- reading functions

strToIntList :: String -> [Int]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Int
toInt [] = 0
toInt (x:xs) = (digitToInt x) * 10^(length xs)  + toInt xs

-- first :: String -> Char -> String

split :: String -> Char -> [String]
split [] _ = []
split xs c = (first xs c) : split (rest xs c) c where
                            first [] c = []
                            first (x:xs) c| x==c = []
                                            | otherwise = x : first xs c
                            rest [] c = []
                            rest (x:xs) c| x==c = xs
                                         | otherwise = rest xs c

-- solving functions

maxL :: Ord a => [a] -> a
maxL (x:[]) = x
maxL (x:xs) = max x (maxL xs)

getOneOut :: Eq a => a -> [a] -> [a]
getOneOut x [] = []
getOneOut x (y:ys)| x==y = ys
                  | otherwise = y: (getOneOut x ys)

max2L :: Ord a => [a] -> a
max2L xs = maxL (getOneOut (maxL xs) xs)

solve :: [Int] -> Int
solve xs = min ((max2L xs)-1) (max 0 (length xs)-2)

solveN :: Int -> IO ()
solveN 0 = return ()
solveN n =    do
                getLine
                t  <- getLine
                (putStrLn . show . solve . strToIntList) t
                solveN (n-1)

solveNf :: Int -> Handle -> IO ()
solveNf 0 h = return ()
solveNf n h =  do
                hGetLine h
                t  <- hGetLine h
                (putStrLn . show . solve . strToIntList) t
                solveNf (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            t <- hGetLine stdin
            solveNf (toInt t) stdin

            -- hClose h
            return ()

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM_)
import Data.Char (ord)
import Data.List (sortOn, sort)
import Data.Ord (Down (Down))

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0
parseInts = fmap parseInt . words

main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum $ do
    n <- fmap parseInt getLine
    a <- fmap parseInts getLine
    let b = sortOn Down a
    print (min (length b - 2) (b !! 1 - 1))

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    print $ (sort str !! (x - 2)) - 1

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    let srt = sort str
    print $ (srt !! (x - 2)) - 1

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ \_ -> do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    let srt = sort str
    print $ (srt !! (x - 2)) - 1


Valera is a lazy student. He has m clean bowls and k clean plates. Valera has made an eating plan for the next n days. As Valera is lazy, he will eat exactly one dish per day. At that, in order to eat a dish, he needs exactly one clean plate or bowl. We know that Valera can cook only two types of dishes. He can eat dishes of the first type from bowls and dishes of the second type from either bowls or plates. When Valera finishes eating, he leaves a dirty plate/bowl behind. His life philosophy doesn't let him eat from dirty kitchenware. So sometimes he needs to wash his plate/bowl before eating. Find the minimum number of times Valera will need to wash a plate/bowl, if he acts optimally.

The first line of the input contains three integers n, m, k (1 ≤ n, m, k ≤ 1000) — the number of the planned days, the number of clean bowls and the number of clean plates. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 2). If ai equals one, then on day i Valera will eat a first type dish. If ai equals two, then on day i Valera will eat a second type dish.

Print a single integer — the minimum number of times Valera will need to wash a plate/bowl.

NoteIn the first sample Valera will wash a bowl only on the third day, so the answer is one.In the second sample, Valera will have the first type of the dish during all four days, and since there are only three bowls, he will wash a bowl exactly once.In the third sample, Valera will have the second type of dish for all three days, and as they can be eaten from either a plate or a bowl, he will never need to wash a plate/bowl.

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

main = do
	[ n, m, k ] <- map ( read :: String -> Int ) . words <$> getLine
	as <- map read . words <$> getLine
	print $ solve as m k

solve [] m k = ( - min m 0 ) + ( - min k 0 )
solve (a:as) m k
	| a == 1 = solve as ( m - 1 ) k
	| a == 2 = if 0 < k then solve as m ( k - 1 ) else solve as ( m - 1 ) k

main :: IO()
main = print . solve . map read . words =<< getContents

solve :: [Int] -> Int
solve (n:m:k:a) = solve' m k a

solve' :: Int -> Int -> [Int] -> Int
solve' _ _ []    = 0
solve' 0 m (1:x) = 1 + solve' 0 m x
solve' n m (1:x) = solve' (n - 1) m x
solve' 0 0 (2:x) = 1 + solve' 0 0 x
solve' n 0 (2:x) = solve' (n - 1) 0 x
solve' n m (2:x) = solve' n (m - 1) x

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readInts
    as <- readInts
    print $ solve n m k as

solve n m k as = go m k as
    where
    go _ _ [] = 0
    go 0 k (1:as) = 1+ go 0 k as
    go m k (1:as) = go (m-1) k as
    go 0 0 (2:as) = length as+1
    go m 0 (2:as) = go (m-1) 0 as
    go m k (2:as) = go m (k-1) as

import Control.Applicative

data Type = One | Two deriving Eq
type Bowl = Int
type Plate = Int

main = do
    [n,bowls,plates] <- map read.words <$> getLine :: IO [Int]
    types <- getPlan n
    putStrLn.show $ washPlan bowls plates types

getPlan _ = map convert.words <$> getLine where
    convert "1" = One
    convert "2" = Two

washPlan :: Bowl -> Plate -> [Type] -> Int
washPlan b p [] = 0
washPlan 0 p (One:ts) = 1 + washPlan 0 p ts
washPlan b p (One:ts) = washPlan (b-1) p ts
washPlan 0 0 (Two:ts) = 1 + washPlan 0 0 ts
washPlan 0 p (Two:ts) = washPlan 0 (p-1) ts
washPlan b 0 (Two:ts) = washPlan (b-1) 0 ts
washPlan b p (Two:ts) = washPlan b (p-1) ts

import Control.Applicative
import Control.Monad

main = do
  [[n,m,k],xs] <- replicateM 2 $ map read . words <$> getLine
  print $ eat 0 m k xs
eat c _ _ []     = c
eat c 0 k (1:xs) = eat (c+1) 0 k xs
eat c m k (1:xs) = eat c (m-1) k xs
eat c 0 0 (2:xs) = eat (c+1) 0 0 xs
eat c 0 k (2:xs) = eat c 0 (k-1) xs
eat c m 0 (2:xs) = eat c (m-1) 0 xs
eat c m k (2:xs) = eat c m (k-1) xs

import Control.Monad
import Control.Applicative

solve :: Int -> Int -> [Int] -> Int
solve _ _ [] = 0
solve bowls plates (d:ds)
  | d == 1    =  if ( bowls > 0 )   then solve (bowls-1) plates ds
                                    else 1 + solve bowls plates ds
  | otherwise =  if ( plates > 0 )  then solve bowls (plates-1) ds
                                    else if ( bowls > 0 ) then  solve (bowls-1) plates ds
                                                          else  1 + solve bowls plates ds
main :: IO ()
main = do
  firstLine <- getLine
  let [n,bowls,plates] = map read (words firstLine) :: [Int]

  secondLine <- getLine
  let days = map read (words secondLine) :: [Int]

  print $ solve bowls plates days

import Data.List (foldl')

main :: IO ()
main = getContents >>= print . solve . map read . words

solve :: [Int] -> Int
solve (_:m:k:as) = snd $ foldl' f ((m, k), 0) as
  where f ((b, c), d) 1 | b > 0 = ((b - 1, c), d)
                        | otherwise = ((b, c), d + 1)
        f ((b, c), d) _ | c > 0 = ((b, c - 1), d)
                        | b > 0 = ((b - 1, c), d)
                        | otherwise = ((b, c), d + 1)
solve _ = undefined

module Main  where

data DishType = Flat | Deep deriving (Eq, Show)

main = do
	dishesString <- getLine
	let dishes = map read $ drop 1 $ words dishesString
	foodString <- getLine
	let food = map read $ words foodString
	print $ useDishes (food :: [Int]) (head (dishes :: [Int]), head $ drop 1 (dishes :: [Int]))

useDishes :: Integral a => [a] -> (a, a) -> a
useDishes dishes (deep, flat) = useDishes0 dishes (deep, flat) 0 (deep, flat)

useDishes0 :: Integral a => [a] -> (a, a) -> a -> (a, a) -> a
useDishes0 [] (totalDeep, totalFlat) washes (deep, flat) = washes
useDishes0 (x:xs) (totalDeep, totalFlat) washes (deep, flat)
	| x == 2 && flat > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep, flat-1)
	| x == 2 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
	| x == 2 			 = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washAnyDish (deep, flat) (totalDeep, totalFlat)
	| x == 1 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
	| otherwise 		 = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washADish Deep (deep, flat) (totalDeep, totalFlat)

washAnyDish :: Integral a => (a, a) -> (a, a) -> (a, a)
washAnyDish (deep, flat) (totalDeep, totalFlat)
	| totalDeep > 0  = (deep, flat)
	| totalFlat > 0  = (deep, flat)
	| otherwise = error "no dishes exception, sorry"

washADish :: Integral a => DishType -> (a, a) -> (a, a) -> (a, a)
washADish dishType (deep, flat) (totalDeep, totalFlat)
	| dishType == Deep && totalDeep > 0  = (deep, flat)
	| dishType == Flat && totalFlat > 0  = (deep, flat)
	| otherwise = error "no dishes exception, sorry"

import Control.Applicative

main=do
	[n,a,b]<-  map read . words <$> getLine:: IO [Int]
	r<- map read. words <$> getLine ::IO [Int]
	let r1 = length $ filter (==1) r
	let r2 = length $ filter (==2) r
	let r3=  (max (r1-a) 0)
	let r4 = max ( (max (r2-b) 0) - (if a>r1 then a-r1 else 0)) 0
	print $ r3+r4

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readInts
    as <- readInts
    print $ solve n m k as

solve n m k as = go m k as
    where
    go _ _ [] = 0
    go 0 _ (1:as) = length as+1
    go m k (1:as) = go (m-1) k as
    go 0 0 (2:as) = length as+1
    go m 0 (2:as) = go (m-1) 0 as
    go m k (2:as) = go m (k-1) as

module Main  where

data DishType = Flat | Deep deriving (Eq, Show)

main = do
    dishesString <- getLine
    let dishes = map read $ drop 1 $ words dishesString
    foodString <- getLine
    let food = map read $ words foodString
    print $ useDishes (food :: [Int]) (head (dishes :: [Int]), head $ drop 1 (dishes :: [Int]))

useDishes :: Integral a => [a] -> (a, a) -> a
useDishes dishes (deep, flat) = useDishes0 dishes (deep, flat) 0 (deep, flat)

useDishes0 :: Integral a => [a] -> (a, a) -> a -> (a, a) -> a
useDishes0 [] (totalDeep, totalFlat) washes (deep, flat) = washes
useDishes0 (x:xs) (totalDeep, totalFlat) washes (deep, flat)
    | x == 2 && flat > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep, flat-1)
    | x == 2 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
    | x == 2             = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washAnyDish (deep, flat) (totalDeep, totalFlat)
    | x == 1 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
    | otherwise          = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washADish Deep (deep, flat) (totalDeep, totalFlat)

washAnyDish :: Integral a => (a, a) -> (a, a) -> (a, a)
washAnyDish (deep, flat) (totalDeep, totalFlat)
    | totalDeep > 0  = (deep + 1, flat)
    | totalFlat > 0  = (deep, flat + 1)
    | otherwise = error "no dishes exception, sorry"

washADish :: Integral a => DishType -> (a, a) -> (a, a) -> (a, a)
washADish dishType (deep, flat) (totalDeep, totalFlat)
    | dishType == Deep && totalDeep > 0  = (deep + 1, flat)
    | dishType == Flat && totalFlat > 0  = (deep, flat + 1)
    | otherwise = error "no dishes exception, sorry"

import Control.Applicative

main=do
	[n,a,b]<-  map read . words <$> getLine:: IO [Int]
	r<- map read. words <$> getLine ::IO [Int]
	let r1 = length $ filter (==1) r
	let r2 = length $ filter (==2) r
	let r3=  (max (r1-a) 0)
	let r4 = (max (r2-b) 0) - (if a>r1 then a-r1 else 0)
	print $ r3+r4


Berland shop sells $$$n$$$ kinds of juices. Each juice has its price $$$c_i$$$. Each juice includes some set of vitamins in it. There are three types of vitamins: vitamin "A", vitamin "B" and vitamin "C". Each juice can contain one, two or all three types of vitamins in it.Petya knows that he needs all three types of vitamins to stay healthy. What is the minimum total price of juices that Petya has to buy to obtain all three vitamins? Petya obtains some vitamin if he buys at least one juice containing it and drinks it.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 1\,000)$$$ — the number of juices. Each of the next $$$n$$$ lines contains an integer $$$c_i$$$ $$$(1 \le c_i \le 100\,000)$$$ and a string $$$s_i$$$ — the price of the $$$i$$$-th juice and the vitamins it contains. String $$$s_i$$$ contains from $$$1$$$ to $$$3$$$ characters, and the only possible characters are "A", "B" and "C". It is guaranteed that each letter appears no more than once in each string $$$s_i$$$. The order of letters in strings $$$s_i$$$ is arbitrary.

Print -1 if there is no way to obtain all three vitamins. Otherwise print the minimum total price of juices that Petya has to buy to obtain all three vitamins.

NoteIn the first example Petya buys the first, the second and the fourth juice. He spends $$$5 + 6 + 4 = 15$$$ and obtains all three vitamins. He can also buy just the third juice and obtain three vitamins, but its cost is $$$16$$$, which isn't optimal.In the second example Petya can't obtain all three vitamins, as no juice contains vitamin "C".

import Control.Applicative
import Data.List
import Data.Int

main = do
  n <- readLn :: IO Int
  dat <- map ((\[a,b] -> (read a, sort b)) . words) . lines <$> getContents :: IO [(Int64,String)]

  let
    inf = 10^9
    f str = minimum $ inf : (map fst . filter ((==str) . snd) $ dat)
    a = f "A"
    b = f "B"
    c = f "C"
    ab = f "AB"
    bc = f "BC"
    ac = f "AC"
    abc = f "ABC"

    ans = minimum [abc, a+b+c, ab+(minimum [c,bc,ac]), bc+(minimum [a,ab,ac]), ac+(minimum [b,ab,bc])]

  print $ if ans < inf then ans else -1

import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int

main = do
  n <- readLn :: IO Int
  dat <- map ((\[a,b] -> (read a, sort b)) . words) . lines <$> getContents :: IO [(Int64,String)]

  let
    inf = 10^9
    a = minimum $ inf : (map fst . filter ((=="A") . snd) $ dat)
    b = minimum $ inf : (map fst . filter ((=="B") . snd) $ dat)
    c = minimum $ inf : (map fst . filter ((=="C") . snd) $ dat)
    ab = minimum $ inf : (map fst . filter ((=="AB") . snd) $ dat)
    bc = minimum $ inf : (map fst . filter ((=="BC") . snd) $ dat)
    ac = minimum $ inf : (map fst . filter ((=="AC") . snd) $ dat)
    abc = minimum $ inf : (map fst . filter ((=="ABC") . snd) $ dat)

    ans = minimum [abc, a+b+c, ab+(minimum [c,bc,ac]), bc+(minimum [a,ab,ac]), ac+(minimum [b,ab,bc])]

  print $ if ans < inf then ans else -1


Further research on zombie thought processes yielded interesting results. As we know from the previous problem, the nervous system of a zombie consists of n brains and m brain connectors joining some pairs of brains together. It was observed that the intellectual abilities of a zombie depend mainly on the topology of its nervous system. More precisely, we define the distance between two brains u and v (1 ≤ u, v ≤ n) as the minimum number of brain connectors used when transmitting a thought between these two brains. The brain latency of a zombie is defined to be the maximum distance between any two of its brains. Researchers conjecture that the brain latency is the crucial parameter which determines how smart a given zombie is. Help them test this conjecture by writing a program to compute brain latencies of nervous systems.In this problem you may assume that any nervous system given in the input is valid, i.e., it satisfies conditions (1) and (2) from the easy version.

The first line of the input contains two space-separated integers n and m (1 ≤ n, m ≤ 100000) denoting the number of brains (which are conveniently numbered from 1 to n) and the number of brain connectors in the nervous system, respectively. In the next m lines, descriptions of brain connectors follow. Every connector is given as a pair of brains a b it connects (1 ≤ a, b ≤ n and a ≠ b).

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Node = Int
type AdjList = M.Map Node [Node]

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

data Tree a = Tree {root :: a,
                    succs :: [Tree a]} deriving Show

edgeListToAdj :: Int -> [[Int]] ->  AdjList
edgeListToAdj n es = let adjList = M.fromList [(i, []) | i <- [1..n]] in
    foldl (\adj [x, y] -> ((M.adjust (x:) y) . (M.adjust (y:) x)) adj) adjList es

edgeListToTree :: Int -> [[Int]] -> Tree Int
edgeListToTree n es = constrTree 1 (S.fromList [1]) where
    adjList = edgeListToAdj n es
    constrTree i used = Tree {root = i,
                              succs = [constrTree j (S.insert j used) | j <- adjList M.! i, not (S.member j used)]}

labelTreeByMaxHeight :: Tree a -> Tree Int
labelTreeByMaxHeight tree = case (succs tree) of
    [] -> Tree {root = 0, succs = []}
    ts -> Tree {root = maximum (root <$> ts') + 1, succs = ts'} where ts' = labelTreeByMaxHeight <$> ts

maxDistance :: Tree Int -> Int
maxDistance tree = maximum (val:(maxDistance <$> succs tree)) where
    sum' (a, b) = a + b
    comp (a, b) x = if x > b then
                        (b, x)
                    else
                        if x > a then
                            (x, b)
                        else
                            (a, b)
    val = sum' $ foldl comp (0, 0) [root t + 1 | t <- succs tree]

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    putStrLn $ show $ maxDistance $ labelTreeByMaxHeight (edgeListToTree n connectors)

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Node = Int
type AdjList = M.Map Node [Node]

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

data Tree a = Tree {root :: a,
                    succs :: [Tree a]} deriving Show

edgeListToAdj :: Int -> [[Int]] ->  AdjList
edgeListToAdj n es = let adjList = M.fromList [(i, []) | i <- [1..n]] in
    foldl (\adj [x, y] -> ((M.adjust (x:) y) . (M.adjust (y:) x)) adj) adjList es

edgeListToTree :: Int -> [[Int]] -> Tree Int
edgeListToTree n es = constrTree 1 (S.fromList [1]) where
    adjList = edgeListToAdj n es
    constrTree i used = Tree {root = i,
                              succs = [constrTree j (S.insert j used) | j <- adjList M.! i, not (S.member j used)]}

labelTreeByMaxHeight :: Tree a -> Tree Int
labelTreeByMaxHeight tree = case (succs tree) of
    [] -> Tree {root = 0, succs = []}
    ts -> Tree {root = maximum (root <$> ts') + 1, succs = ts'} where ts' = labelTreeByMaxHeight <$> ts

maxDistance :: Tree Int -> Int
maxDistance tree = maximum (val:(maxDistance <$> succs tree)) where
    sum' (a, b) = a + b
    comp (a, b) x = if x > b then
                        (b, x)
                    else
                        if x > a then
                            (x, b)
                        else
                            (a, x)
    val = sum' $ foldl comp (0, 0) [root t + 1 | t <- succs tree]

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    putStrLn $ show $ maxDistance $ labelTreeByMaxHeight (edgeListToTree n connectors)

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Node = Int
type AdjList = M.Map Node [Node]

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

data Tree a = Tree {root :: a,
                    succs :: [Tree a]} deriving Show

edgeListToAdj :: Int -> [[Int]] ->  AdjList
edgeListToAdj n es = let adjList = M.fromList [(i, []) | i <- [1..n]] in
    foldl (\adj [x, y] -> ((M.adjust (x:) y) . (M.adjust (y:) x)) adj) adjList es

edgeListToTree :: Int -> [[Int]] -> Tree Int
edgeListToTree n es = constrTree 1 (S.fromList [1]) where
    adjList = edgeListToAdj n es
    constrTree i used = Tree {root = i,
                              succs = [constrTree j (S.insert j used) | j <- adjList M.! i, not (S.member j used)]}

labelTreeByMaxHeight :: Tree a -> Tree Int
labelTreeByMaxHeight tree = case (succs tree) of
    [] -> Tree {root = 0, succs = []}
    ts -> Tree {root = maximum (root <$> ts') + 1, succs = ts'} where ts' = labelTreeByMaxHeight <$> ts

maxDistance :: Tree Int -> Int
maxDistance tree = maximum (val:(maxDistance <$> succs tree)) where
    sum' (a, b) = a + b
    comp (a, b) x = if x > b then
                        (b, x)
                    else
                        if x > a then
                            (x, b)
                        else
                            (a, x)
    val = sum' $ foldl comp (0, 0) [root t + 1 | t <- succs tree]

main = do
    [n, m] <- readNums
    connectors <- replicateM m readNums
    putStrLn $ show $ (maxBound :: Int)
    --putStrLn $ show $ maxDistance $ labelTreeByMaxHeight (edgeListToTree n connectors)


You are beta testing the new secret Terraria update. This update will add quests to the game!Simply, the world map can be represented as an array of length $$$n$$$, where the $$$i$$$-th column of the world has height $$$a_i$$$.There are $$$m$$$ quests you have to test. The $$$j$$$-th of them is represented by two integers $$$s_j$$$ and $$$t_j$$$. In this quest, you have to go from the column $$$s_j$$$ to the column $$$t_j$$$. At the start of the quest, you are appearing at the column $$$s_j$$$.In one move, you can go from the column $$$x$$$ to the column $$$x-1$$$ or to the column $$$x+1$$$. In this version, you have Spectre Boots, which allow you to fly. Since it is a beta version, they are bugged, so they only allow you to fly when you are going up and have infinite fly duration. When you are moving from the column with the height $$$p$$$ to the column with the height $$$q$$$, then you get some amount of fall damage. If the height $$$p$$$ is greater than the height $$$q$$$, you get $$$p - q$$$ fall damage, otherwise you fly up and get $$$0$$$ damage.For each of the given quests, determine the minimum amount of fall damage you can get during this quest.

The first line of the input contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 10^5; 1 \le m \le 10^5$$$) — the number of columns in the world and the number of quests you have to test, respectively. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the height of the $$$i$$$-th column of the world. The next $$$m$$$ lines describe quests. The $$$j$$$-th of them contains two integers $$$s_j$$$ and $$$t_j$$$ ($$$1 \le s_j, t_j \le n; s_j \ne t_j$$$), which means you have to move from the column $$$s_j$$$ to the column $$$t_j$$$ during the $$$j$$$-th quest. Note that $$$s_j$$$ can be greater than $$$t_j$$$.

Print $$$m$$$ integers. The $$$j$$$-th of them should be the minimum amount of fall damage you can get during the $$$j$$$-th quest completion.

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [n, m] <- ri
    hgts   <- ri
    qs     <- replicateM m ri
    let psumsLR = makePSums [1    ..]           $ hgts
    let psumsRL = makePSums [n,n-1..] . reverse $ hgts
    mapM_ (putStrLn . show . solve (psumsLR,psumsRL)) qs

solve (psN,psR) [s,t] = ans
  where
    ans | (s < t)    = (psN!t) - (psN!s)
        | otherwise  = (psR!t) - (psR!s)
    (!) = (Map.!)
solve _    _     = error "Input error query"

makePSums inds hgts = Map.fromList . zip (inds::[Int]) . scanl (+) 0 $ dmgs
  where
    dmgs = zipWith damage hgts (tail hgts)
    damage a b = max 0 (a - b)

import Data.Array
import Control.Monad (replicateM_)

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

main = getN >>=
       \[n, m] -> getN >>=
       \as -> replicateM_ m $
              pFall (processDamages n as) (processDamages n (reverse as))

processDamages :: Int -> [Int] -> Array Int Int
processDamages n (a:as) = let (_, _, ds) = foldl f (a, 0, [0]) as in
                            listArray (1, n) (reverse ds)
  where f (prevH, prevD, acc) currH = if prevH <= currH
                                      then (currH, prevD, prevD:acc)
                                      else let currD = prevD + prevH - currH in
                                             (currH, currD, currD:acc)

pFall :: Array Int Int -> Array Int Int -> IO ()
-- pFall l r = print l >> print r
pFall l r = let (1, n) = bounds l in
              getN >>=
              \[s, t] -> print $ if s <= t
                                 then (l!t) - (l!s)
                                 else (r!(n-t+1)) - (r!(n-s+1))


Petya's friends made him a birthday present — a bracket sequence. Petya was quite disappointed with his gift, because he dreamed of correct bracket sequence, yet he told his friends nothing about his dreams and decided to fix present himself. To make everything right, Petya is going to move at most one bracket from its original place in the sequence to any other position. Reversing the bracket (e.g. turning "(" into ")" or vice versa) isn't allowed. We remind that bracket sequence $$$s$$$ is called correct if:   $$$s$$$ is empty;  $$$s$$$ is equal to "($$$t$$$)", where $$$t$$$ is correct bracket sequence;  $$$s$$$ is equal to $$$t_1 t_2$$$, i.e. concatenation of $$$t_1$$$ and $$$t_2$$$, where $$$t_1$$$ and $$$t_2$$$ are correct bracket sequences. For example, "(()())", "()" are correct, while ")(" and "())" are not. Help Petya to fix his birthday present and understand whether he can move one bracket so that the sequence becomes correct.

First of line of input contains a single number $$$n$$$ ($$$1 \leq n \leq 200\,000$$$) — length of the sequence which Petya received for his birthday. Second line of the input contains bracket sequence of length $$$n$$$, containing symbols "(" and ")".

Print "Yes" if Petya can make his sequence correct moving at most one bracket. Otherwise print "No".

NoteIn the first example, Petya can move first bracket to the end, thus turning the sequence into "()", which is correct bracket sequence.In the second example, there is no way to move at most one bracket so that the sequence becomes correct.In the third example, the sequence is already correct and there's no need to move brackets.

import Data.List
getInt :: IO Int
getInt = read `fmap` getLine
mf :: Char -> Int
mf '(' = 1
mf ')' = -1
mf _   = 0
work :: Int -> [Int] -> String
work n ls
    | odd n               = "No"
    | mn >= -1 && s == 0  = "Yes"
    | otherwise           = "No" where
        (mn, s) = foldl' func (233333, 0) ls where
            func (mn, s) x = (min mn $ s + x, s + x)
main :: IO ()
main = do
    n <- getInt
    ls <- getLine
    putStrLn $ work n $ map mf ls


Leha plays a computer game, where is on each level is given a connected graph with n vertices and m edges. Graph can contain multiple edges, but can not contain self loops. Each vertex has an integer di, which can be equal to 0, 1 or  - 1. To pass the level, he needs to find a «good» subset of edges of the graph or say, that it doesn't exist. Subset is called «good», if by by leaving only edges from this subset in the original graph, we obtain the following: for every vertex i, di =  - 1 or it's degree modulo 2 is equal to di. Leha wants to pass the game as soon as possible and ask you to help him. In case of multiple correct answers, print any of them.

The first line contains two integers n, m (1 ≤ n ≤ 3·105, n - 1 ≤ m ≤ 3·105) — number of vertices and edges. The second line contains n integers d1, d2, ..., dn ( - 1 ≤ di ≤ 1) — numbers on the vertices. Each of the next m lines contains two integers u and v (1 ≤ u, v ≤ n) — edges. It's guaranteed, that graph in the input is connected.

Print  - 1 in a single line, if solution doesn't exist. Otherwise in the first line k — number of edges in a subset. In the next k lines indexes of edges. Edges are numerated in order as they are given in the input, starting from 1.

NoteIn the first sample we have single vertex without edges. It's degree is 0 and we can not get 1.

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (elemIndex)
import qualified Data.Array.Unboxed as A (UArray)
import qualified Data.Array.IArray as A (Array, listArray, accumArray, (!))
import qualified Data.Array.MArray.Safe as A (newArray, readArray, writeArray, getElems)
import qualified Data.Array.ST.Safe as ST (STUArray)
import qualified Control.Monad as M (forM, forM_)
import qualified Control.Monad.ST.Safe as ST (runST, ST)

readInt = fst . M.fromJust . C.readInt

dfs :: A.UArray Int Int -> A.Array Int [(Int, Int)] -> Int ->
       ST.STUArray s Int Bool -> ST.STUArray s Int Bool -> ST.ST s Bool
dfs ds edges i vn vm = do
    A.writeArray vn i True
    (even . sum -> xeven) <- M.forM (edges A.! i) $ \(xb, xi) -> do
        iv <- A.readArray vn xb
        if iv then return 0
        else do
            xsub <- dfs ds edges xb vn vm
            if not xsub then do
                A.writeArray vm xi True
                return 1
            else return 0
    case xeven of
        True  -> return ((ds A.! i) == 0)
        False -> return ((ds A.! i) == 1)

run n m ds edges = ST.runST $ do
    vn <- A.newArray (1, n) False :: ST.ST s (ST.STUArray s Int Bool)
    vm <- A.newArray (1, m) False :: ST.ST s (ST.STUArray s Int Bool)
    dfs ds edges 1 vn vm
    vme <- A.getElems vm
    return $ (map fst . filter snd . zip [1..m]) vme

main = do
    (map readInt . C.words -> [n, m]) <- B.getLine
    (map readInt . C.words -> ds) <- B.getLine
    ms <- M.forM [1..m] $ \i -> do
        (map readInt . C.words -> [u, v]) <- B.getLine
        return (u, (v, i))
    let edges = A.accumArray (flip (:)) [] (1, n) (ms ++ map (\(a, (b, c)) -> (b, (a, c))) ms)
        nneg = length $ filter (== -1) $ ds
        none = length $ filter (==  1) $ ds
    if nneg == 0 && none `mod` 2 == 1 then
        putStrLn "-1"
    else do
        let dds = case nneg of
                0 -> A.listArray (1, n) ds
                otherwise -> let idx = M.fromJust (L.elemIndex (-1) ds) in
                    A.listArray (1, n) [ case d of
                        -1 -> if id == idx && none `mod` 2 == 1 then 1 else 0
                        otherwise -> d | (id, d) <- zip [0..] ds ]
            mms = run n m dds edges
            lms = length mms
        putStrLn $ show $ lms
        M.forM_ mms (putStrLn . show)


You are given two strings $$$s$$$ and $$$t$$$ consisting of lowercase Latin letters. Also you have a string $$$z$$$ which is initially empty. You want string $$$z$$$ to be equal to string $$$t$$$. You can perform the following operation to achieve this: append any subsequence of $$$s$$$ at the end of string $$$z$$$. A subsequence is a sequence that can be derived from the given sequence by deleting zero or more elements without changing the order of the remaining elements. For example, if $$$z = ac$$$, $$$s = abcde$$$, you may turn $$$z$$$ into following strings in one operation:   $$$z = acace$$$ (if we choose subsequence $$$ace$$$);  $$$z = acbcd$$$ (if we choose subsequence $$$bcd$$$);  $$$z = acbce$$$ (if we choose subsequence $$$bce$$$). Note that after this operation string $$$s$$$ doesn't change.Calculate the minimum number of such operations to turn string $$$z$$$ into string $$$t$$$.

The first line contains the integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of test cases. The first line of each testcase contains one string $$$s$$$ ($$$1 \le |s| \le 10^5$$$) consisting of lowercase Latin letters. The second line of each testcase contains one string $$$t$$$ ($$$1 \le |t| \le 10^5$$$) consisting of lowercase Latin letters. It is guaranteed that the total length of all strings $$$s$$$ and $$$t$$$ in the input does not exceed $$$2 \cdot 10^5$$$.

For each testcase, print one integer — the minimum number of operations to turn string $$$z$$$ into string $$$t$$$. If it's impossible print $$$-1$$$.

import Data.Ord
import Data.Int
import Data.Char
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (s, t) <- liftM2 (,) gets gets
    putln $ f2 s t

f2 :: String -> String -> Int64
f2 s t =    let arr = runSTUArray $ do
                a <- newArray ((0, 0), (25, length s + 1)) (-1) :: ST s (STUArray s (Int, Int) Int64)
                b <- newArray (0, 25) (-1) :: ST s (STUArray s Int Int64)
                foldrM (\c x ->
                    do
                        forM_ [0..25] (\y -> do
                            v <- readArray b y
                            writeArray a (y, x) v
                            )
                        writeArray b ((ord c) - (ord 'a')) $ fromIntegral (x - 1)
                        return $ x - 1
                    ) (length s) s
                forM_ [0..25] (\y -> do
                    v <- readArray b y
                    writeArray a (y, 0) v
                    )
                return a
            in
            let o = foldlM (\(loop, cur) c ->
                    if arr ! ((ord c) - (ord 'a'), fromIntegral cur) == -1 then
                        if arr ! ((ord c) - (ord 'a'), 0) == -1 then
                            Nothing
                        else
                            Just (loop + 1, arr ! ((ord c) - (ord 'a'), 0) + 1)
                    else
                        Just (loop, arr ! ((ord c) - (ord 'a'), fromIntegral cur) + 1)
                    ) (1, 0) t
            in
            case o of
                Nothing -> -1
                Just (l, _) -> l

import Data.Ord
import Data.Int
import Data.Char
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (s, t) <- liftM2 (,) gets gets
    putln $ f2 s t

f2 :: String -> String -> Int64
f2 s t =    let arr = runSTUArray $ do
                a <- newArray ((0, 0), (25, length s)) (-1) :: ST s (STUArray s (Int, Int) Int64)
                b <- newArray (0, 25) (-1) :: ST s (STUArray s Int Int64)
                foldrM (\c x ->
                    do
                        forM_ [0..25] (\y -> do
                            v <- readArray b y
                            writeArray a (y, x) v
                            )
                        writeArray b ((ord c) - (ord 'a')) $ fromIntegral x
                        return $ x - 1
                    ) (length s - 1) s
                forM_ [0..25] (\y -> do
                    v <- readArray b y
                    writeArray a (y, 0) v
                    )
                return a
            in
            let o = foldlM (\(loop, cur) c ->
                    if arr ! ((ord c) - (ord 'a'), fromIntegral cur) == -1 then
                        if arr ! ((ord c) - (ord 'a'), 0) == -1 then
                            Nothing
                        else
                            Just (loop + 1, arr ! ((ord c) - (ord 'a'), 0))
                    else
                        Just (loop, arr ! ((ord c) - (ord 'a'), fromIntegral cur))
                    ) (1, 0) t
            in
            case o of
                Nothing -> -1
                Just (l, _) -> l