The subsequence is a sequence that can be derived from another sequence by deleting some elements without changing the order of the remaining elements.You are given an integer $$$n$$$. You have to find a sequence $$$s$$$ consisting of digits $$$\{1, 3, 7\}$$$ such that it has exactly $$$n$$$ subsequences equal to $$$1337$$$.For example, sequence $$$337133377$$$ has $$$6$$$ subsequences equal to $$$1337$$$:   $$$337\underline{1}3\underline{3}\underline{3}7\underline{7}$$$ (you can remove the second and fifth characters);  $$$337\underline{1}\underline{3}3\underline{3}7\underline{7}$$$ (you can remove the third and fifth characters);  $$$337\underline{1}\underline{3}\underline{3}37\underline{7}$$$ (you can remove the fourth and fifth characters);  $$$337\underline{1}3\underline{3}\underline{3}\underline{7}7$$$ (you can remove the second and sixth characters);  $$$337\underline{1}\underline{3}3\underline{3}\underline{7}7$$$ (you can remove the third and sixth characters);  $$$337\underline{1}\underline{3}\underline{3}3\underline{7}7$$$ (you can remove the fourth and sixth characters). Note that the length of the sequence $$$s$$$ must not exceed $$$10^5$$$.You have to answer $$$t$$$ independent queries.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10$$$) — the number of queries.  Next $$$t$$$ lines contains a description of queries: the $$$i$$$-th line contains one integer $$$n_i$$$ ($$$1 \le n_i \le 10^9$$$).

For the $$$i$$$-th query print one string $$$s_i$$$ ($$$1 \le |s_i| \le 10^5$$$) consisting of digits $$$\{1, 3, 7\}$$$. String $$$s_i$$$ must have exactly $$$n_i$$$ subsequences $$$1337$$$. If there are multiple such strings, print any of them.

    import Control.Monad

    triangleNums = [(i, i*(i+1) `div` 2) | i <- reverse [1..100000]]

    decomp 0 _ = []
    decomp _ [] = error "NOT DECOMPOSABLE"
    decomp i xs@(x:_)
        | i >= snd x = fst x : decomp (i- snd x) xs
        | otherwise = decomp i $ tail xs

    printThreesAndSevens [] _ = return ()
    printThreesAndSevens is@(i:i') idx
        | i == idx = do
            putStr "7"
            printThreesAndSevens i' idx
        | otherwise = do
            putStr "3"
            printThreesAndSevens is $ idx + 1

    main :: IO ()
    main = do
        t <- liftM (read :: String -> Int) getLine
        forM_ [1..t] $ \x -> do
            n <- liftM read getLine
            let composed = reverse $ decomp n triangleNums
            putStr "13"
            printThreesAndSevens composed 0
            putStrLn ""

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as LB8
import qualified Data.ByteString.Char8 as B8

find3 n = if n == 1 then 1 else go 2
  where go v = if v * pred v `div` 2 <= n then go (v + 1) else v - 1

getInt = (fromIntegral . fst . fromJust . B8.readInt) <$> B8.getLine

main :: IO ()
main = do
  a <- getInt
  replicateM_ a $ do
    b <- getInt
    let c3 = find3 b
    putStr "1"
    putStr "33"
    when (c3 /= 1) $ LB8.putStr $ LB8.replicate (fromIntegral $ b - ((c3 * pred c3) `div` 2)) '7'
    LB8.putStr $ LB8.replicate (fromIntegral $ c3 - 2) '3'
    putStrLn "7"

import Control.Monad

triangleNums = [(i, i*(i+1) `div` 2) | i <- reverse [1..100000]]

decomp 0 _ = []
decomp _ [] = error "NOT DECOMPOSABLE"
decomp i xs@(x:_)
    | i >= snd x = fst x : decomp (i- snd x) xs
    | otherwise = decomp i $ tail xs

printThreesAndSevens [] _ = return ()
printThreesAndSevens is@(i:i') idx
    | i == idx = do
        putStr "7"
        printThreesAndSevens i' idx
    | otherwise = do
        putStr "3"
        printThreesAndSevens is $ idx + 1

main :: IO ()
main = do
    n <- liftM read getLine
    let composed = reverse $ decomp n triangleNums
    putStr "13"
    printThreesAndSevens composed 0

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as LB8
import qualified Data.ByteString.Char8 as B8

find3 n = if n == 1 then 1 else go 2
  where go v = if v * pred v `div` 2 <= n then go (v + 1) else v - 1

getInt = (fromIntegral . fst . fromJust . B8.readInt) <$> B8.getLine

main :: IO ()
main = do
  a <- getInt
  replicateM_ a $ do
    b <- getInt
    let c3 = find3 b
    putStr "1"
    putStr "33"
    when (c3 /= b) $ LB8.putStr $ LB8.replicate (fromIntegral $ b - ((c3 * pred c3) `div` 2)) '7'
    LB8.putStr $ LB8.replicate (fromIntegral $ c3 - 2) '3'
    putStrLn "7"

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as LB8
import qualified Data.ByteString.Char8 as B8

find3 n = if n == 1 then 1 else go 2
  where go v = if v * pred v `div` 2 <= n then go (v + 1) else v - 1

getInt = (fromIntegral . fst . fromJust . B8.readInt) <$> B8.getLine

main :: IO ()
main = do
  a <- getInt
  replicateM_ a $ do
    b <- getInt
    let c3 = find3 b
    putStr "1"
    putStr "33"
    LB8.putStr $ LB8.replicate (fromIntegral $ b - ((c3 * pred c3) `div` 2)) '7'
    LB8.putStr $ LB8.replicate (fromIntegral $ c3 - 2) '3'
    putStrLn "7"


Recently, a start up by two students of a state university of city F gained incredible popularity. Now it's time to start a new company. But what do we call it?The market analysts came up with a very smart plan: the name of the company should be identical to its reflection in a mirror! In other words, if we write out the name of the company on a piece of paper in a line (horizontally, from left to right) with large English letters, then put this piece of paper in front of the mirror, then the reflection of the name in the mirror should perfectly match the line written on the piece of paper.There are many suggestions for the company name, so coming up to the mirror with a piece of paper for each name wouldn't be sensible. The founders of the company decided to automatize this process. They asked you to write a program that can, given a word, determine whether the word is a 'mirror' word or not.

The first line contains a non-empty name that needs to be checked. The name contains at most 105 large English letters. The name will be written with the next sans serif font:

Print 'YES' (without the quotes), if the given name matches its mirror reflection. Otherwise, print 'NO' (without the quotes).

startUp s = (s == reverse s) && ( and [x `elem` ['A','H','I','M','T','W','Y','O','X','V','U'] | x <- s ])
main = do
    s <- getLine
    putStr $ if (startUp s) then "YES" else "NO"

-- Codeforces 420A

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
    xs <- getLine
    if xs == reverse xs && all (`elem` "AHIMTWYOXVU") xs
       then putStrLn "YES"
       else putStrLn "NO"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem) -- generalized by Data.Foldable
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index

bsGetLine :: IO ByteString
bsGetLine = BS.getLine <&> fst . BS.spanEnd isSpace
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

isMirror s = s == BS.reverse s && BS.all (`elem` "AHIMOTUVWXY") s

main :: IO ()
main = do
	s <- bsGetLine
	putStrLn $ if isMirror s then "YES" else "NO"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

isMirror s = s == reverse s && all (`elem` "AHIMOTUVWXY") s

main :: IO ()
main = do
	s <- getLine
	putStrLn $ if isMirror s then "YES" else "NO"

main = do
    line <- getLine
    if line==reverseWords line && checkString line "BCDEFGJKLNPQRSZ"
        then do
			putStrLn $ "YES"
        else do
            putStrLn $ "NO"

reverseWords :: String -> String
reverseWords = unwords . map reverse . words
checkElement :: Char -> String -> Bool
checkElement x [] = False
checkElement x (y:ys)
			| x==y 		= True
			| otherwise = checkElement x ys
checkString :: String -> String -> Bool
checkString x [] = True
checkString x (y:ys)
			| checkElement y x = False
			| otherwise = checkString x ys

main=getLine>>=putStrLn.f
f cs|all(`elem`"AHIMOTUVWXY")cs,cs==reverse cs="YES"|0<1="NO"

startUp s = (s == reverse s) && ( and [x `elem` ['A','H','I','M','T','W','Y','O','X'] | x <- s ])
main = do
    s <- getLine
    putStr $ if (startUp s) then "YES" else "NO"

startUp s = (s == reverse s) && ( and [x `elem` ['A','H','I','M','T','W','Y'] | x <- s ])
main = do
    s <- getLine
    putStr $ if (startUp s) then "YES" else "NO"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Prelude hiding (all, elem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (forM_)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = List.genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

isMirror s = s == BS.reverse s && BS.all (`elem` "AHIMOTUVWXY") s

main :: IO ()
main = do
	s <- BS.getLine
	print $ BS.length s
	forM_ (BS.unpack s) $ \x -> print x
	putStrLn $ if isMirror s then "YES" else "NO"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Prelude hiding (all, elem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = List.genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

isMirror s = s == BS.reverse s && BS.all (`elem` "AHIMOTUVWXY") s

main :: IO ()
main = do
	s <- BS.getLine
	putStrLn $ if isMirror s then "YES" else "NO"

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Prelude hiding (all, elem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = List.genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

isMirror s = s == BS.reverse s && BS.all (`elem` "AHIMOTUVWXY") s

main :: IO ()
main = do
	s <- BS.getLine
	hPrint stderr $ BS.length s
	putStrLn $ if isMirror s then "YES" else "NO"

main = do
    line <- getLine
    if line==reverseWords line
        then do
			putStrLn $ "Yes"
        else do
            putStrLn $ "No"

reverseWords :: String -> String
reverseWords = unwords . map reverse . words

main = do
    line <- getLine
    if line==reverseWords line
        then do
			putStrLn $ "YES"
        else do
            putStrLn $ "NO"

reverseWords :: String -> String
reverseWords = unwords . map reverse . words

main = do
    line <- getLine
    if line==reverseWords line && checkString line "BCDEFGJKLNPRSZ"
        then do
			putStrLn $ "YES"
        else do
            putStrLn $ "NO"

reverseWords :: String -> String
reverseWords = unwords . map reverse . words
checkElement :: Char -> String -> Bool
checkElement x [] = False
checkElement x (y:ys)
			| x==y 		= True
			| otherwise = checkElement x ys
checkString :: String -> String -> Bool
checkString x [] = True
checkString x (y:ys)
			| checkElement y x = False
			| otherwise = checkString x ys

main=getLine>>=putStrLn.f
f cs|all(`elem`"ABHIMOTUVWXY")cs,cs==reverse cs="YES"|0<1="NO"


The police department of your city has just started its journey. Initially, they don’t have any manpower. So, they started hiring new recruits in groups.Meanwhile, crimes keeps occurring within the city. One member of the police force can investigate only one crime during his/her lifetime.If there is no police officer free (isn't busy with crime) during the occurrence of a crime, it will go untreated.Given the chronological order of crime occurrences and recruit hirings, find the number of crimes which will go untreated.

The first line of input will contain an integer n (1 ≤ n ≤ 105), the number of events. The next line will contain n space-separated integers. If the integer is -1 then it means a crime has occurred. Otherwise, the integer will be positive, the number of officers recruited together at that time. No more than 10 officers will be recruited at a time.

Print a single integer, the number of crimes which will go untreated.

NoteLets consider the second example:  Firstly one person is hired.  Then crime appears, the last hired person will investigate this crime.  One more person is hired.  One more crime appears, the last hired person will investigate this crime.  Crime appears. There is no free policeman at the time, so this crime will go untreated.  One more person is hired.  One more person is hired.  One more person is hired. The answer is one, as one crime (on step 5) will go untreated.

module Main
    where

import System.IO

main = do
    first <- getLine
    second <- getLine
    print . solve 0 0 . map read . words $ second
    where
        solve crimes _ [] =
            crimes
        solve crimes officers (event : events) =
            if officers' < 0 then
                solve (crimes + 1) 0 events
            else
                solve crimes officers' events
            where
                officers' = officers + event

main = do
    getLine
    con<-getLine
    putStr $ (show.solve 0 0.map read.words) con

solve _ k [] = k
solve p k (x:xs)
    |x>0        = solve (p+x) k xs
    |p-1<0      = solve p (k+1) xs
    |otherwise  = solve (p-1) k xs

solve2 events = negate $ minimum $ scanl (+) 0 events

main :: IO ()
main = getContents >>= print . solve2 . map read . words . (!!1) . lines

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

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

solve' :: [Int] -> Int -> Int
solve' []     sum | sum < 0   = abs sum
                  | otherwise = 0
solve' (a:ax) sum | sum < 0   = max (abs sum) (solve' ax (sum + a))
                  | otherwise = solve' ax (sum + a)

-- time limit exceeded
-- use faster list operations

police lst crm pol
  | (null lst) = crm
  | otherwise = if (head lst) == (-1)
                then if pol > 0
                     then police (tail lst) crm (pol-1)
                     else police (tail lst) (crm+1) pol
                else police (tail lst) crm (pol+(head lst))

conv lst cc
  | (null lst) = reverse cc
  | otherwise = conv (tail lst) (((read (head lst))::Int) : cc)

main = do
  ff <- getLine
  ww <- getLine

  let ans = police (conv (words ww) []) 0 0
  putStrLn (show ans)

untreated :: [Int] -> Int
untreated = fst . foldl go (0, 0)
            where go (untr, officers) k | k == -1 && officers > 0 = (untr, officers-1)
                                        | k == -1 = (untr+1, 0)
                                        | otherwise = (untr, officers + k)

main = getLine >> getLine >>= (print . untreated . map read . words)

main = do
  getLine
  xs <- fmap (map read . words) getLine

  let
    (x, _) = foldl f (0, 0) xs
      where
        f (a, b) (-1)
          | b > 0 = (a, b-1)
          | otherwise = (a+1, b)
        f (a, b) x = (a, b+x)

  print x

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine  >> (solve =<< map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = print $ fst $ foldl f (0,0) xs
 where
 f (b1,b2) a = if a<0 && b2==0 then (b1+1,b2) else (b1,b2+a)

main=interact$f.map read.words
f (x:xs)=show.negate.minimum.scanl(+)0$0:xs

main=interact$f.map read.words
f (x:xs)=show.g.minimum.scanl1 (+)$xs
g x |x<0= -x
g x=0

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  let f x = if x < 0 then (-1)*x else 0
  print . f . minimum . scanl1 (+) $ xs

main = interact $ f . map read . words
f (x:xs) = show . g . minimum . scanl1 (+) $ xs
g x | x < 0 = -x
g x = 0

import Control.Applicative
import Data.List (foldl')

main = do
  _ <- getLine
  xs <- map read . words <$> getLine
  let
    f (n, t) x
      | x == (-1) && n == 0 = (n, t+1)
      | x == (-1) = (n-1, t)
      | otherwise = (n+x, t)
   in putStrLn . show . snd $ foldl' f (0, 0) xs

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (-1:xs) 0 = 1 + solve xs 0
solve (-1:xs) num = solve xs (num - 1)
solve (x:xs) num = solve xs (num + x)

main = do
  _ <- getLine
  l <- getLine
  putStrLn $ show $ solve (map read $ words l) 0

import Control.Applicative
import Data.List

process [] _ ni = ni
process (q:qs) np ni | q>0 = process qs (np+q) ni
                    | np>0 = process qs (np-1) ni
                    |otherwise = process qs np (ni+1)

main=do
    n<-     read  <$> getLine::IO Integer
    q<-    map read <$> words <$> getLine::IO [Integer]
    print $  process q 0 0

f (crimes,officers) x
	| x == -1 = if officers ==0 then (crimes+1,0) else (crimes,officers-1)
	| otherwise = (crimes,officers+x)

main = do
	_ <- getLine
	events <- getLine >>= return . map (read :: String -> Int). words
	print . fst $ foldl f (0,0) events

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

solve :: [Int] -> Int
solve = sum . map snd . scanl f (0, 0)
  where f (x, _) z = (max (x + z) 0, max (- x - z) 0)

import Data.List (foldl')
main = interact $ show . fst . foldl' solve (0,0) . map read . tail . words
solve (c,0) (-1) = (c+1,0)
solve (c,p) (-1) = (c,p-1)
solve (c,p) q = (c,p+q)

module Main where

main = interact readAndSolve

readAndSolve :: String -> String
readAndSolve input = show . solve . convert $ input

convert :: String -> [Int]
convert input = let	numbers = (lines input) !! 1 in
				map read (words numbers)

solve :: [Int] -> Int
solve list = abs $ min 0 $ minimum . calcPrefixSums $ list

calcPrefixSums :: [Int] -> [Int]
calcPrefixSums = foldLP (+) 0

foldLP :: (a -> b -> a) -> a -> [b] -> [a]
foldLP _ _ [] = []
foldLP f s (x:xs) = let curS = f s x in curS : foldLP f curS xs

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ z [] = z
foldl' f s (x:xs) = foldl' f (f s x)  xs

import Data.List
strToList = (map (read :: (String -> Integer))).words
f xs = length $ filter (<0) $ snd $ mapAccumL (\x y -> (max 0 (x + y), x + y)) 0 xs
main = do
    n <- fmap strToList getLine
    s <- fmap strToList getLine
    putStrLn $ show $ f s

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = go 0 0 xs
   where
     go !res !police ((-1):xs)
       | police > 0 = go res (police-1) xs
       | otherwise = go (res+1) 0 xs
     go res police (x:xs) = go res (police+x) xs
     go res _ _ = res

main = interact $ show.fst.foldl op (0,0).map read.tail.words

op :: (Int,Int) -> Int -> (Int,Int)
op (ans,cum) num
	| num == -1 && cum > 0 = (ans,cum-1)
	| num == -1 && cum == 0 = (ans+1,cum)
	| otherwise = (ans,cum+num)

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x : xs) rr up
  | x == -1   = if rr >= 1 then solve xs (rr - 1) up else solve xs rr (up + 1)
  | otherwise = solve xs (rr + x) up

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

#!/usr/bin/env runghc
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (n:p:ss) = (:solve ss)$ show . foldr f 0 . map (read::String->Int) . words $ p
  where f p t = max 0 (t-p)

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

solve :: [Int] -> Int
solve = go 0 0
	where
		go u _ [] = u
		go u 0 (-1:xs) = go (u+1) 0 xs
		go u p (-1:xs) = go u (p-1) xs
		go u p ( x:xs) = go u (p+x) xs

main :: IO ()
main = void getLine >> inputInts >>= print . solve

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe

process _ c []  = c
process a c (d:ds)   | d>0 && a>0 = process (d+a) c ds
                     | d>0  = process d c ds
		     | a>0 = process (a-1) c ds
                     | otherwise = process (a-1) (c+1) ds
main=do
	getLine
	s<- map (fst.fromJust.C.readInteger). C.words <$>  C.getLine  ::IO [Integer]
	print $ process 0 0 s

import Data.List

process :: [Int] -> Int
process = length . filter (<0) . scanl' (\acc x -> if x > 0 && acc < 0 then x else acc + x) 0

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

main = do line <- getLine
          let n = (read line) :: Int
          line <- getLine
          let xs = (map read $ words line) :: [Int]
          putStrLn $ show $ countCrime xs 0 0

countCrime [] pol acc = acc
countCrime (x : xs) pol acc
    | x == -1   = if pol > 0 then countCrime xs (pol - 1) acc
                             else countCrime xs pol (acc + 1)
    | x > 0     = countCrime xs (pol + x) acc
    | otherwise = error "shit"

parseInput :: String -> [Int]
parseInput input = xs where
    ls = lines input
    ys = words $ last ls
    xs = map read ys

solve :: Int -> [Int] -> Int
solve n [] = 0
solve n (x:xs)
    | x > 0     = solve (n + x) xs
    | otherwise = case n of
        0 -> 1 + solve n xs
        _ -> solve (n - 1) xs

main :: IO ()
main = do
    input <- getContents
    let xs = parseInput input
    print $ solve 0 xs

countNegativesStart [] = 0
countNegativesStart (x:xs) = if x < 0 then (1 + countNegativesStart xs) else 0

dropNegativesStart [] = []
dropNegativesStart (x:xs) = if x < 0 then dropNegativesStart xs else (x:xs)

dropPositivesEnd [] = []
dropPositivesEnd xs = if last xs > 0 then dropPositivesEnd (init xs) else xs

solve :: [Int] -> Int
solve events = if si < 0 then (abs si) + countNegativesStart events
                 else countNegativesStart events
  where
    si = sum (dropNegativesStart (dropPositivesEnd events))

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

countNegativesStart [] = 0
countNegativesStart (x:xs) = if x < 0 then (1 + countNegativesStart xs) else 0

dropNegativesStart [] = []
dropNegativesStart (x:xs) = if x < 0 then dropNegativesStart xs else (x:xs)

dropPositivesEnd [] = []
dropPositivesEnd xs = if last xs > 0 then dropPositivesEnd (init xs) else xs

solve :: [Int] -> Int
solve events = if si < 0 then ( (abs si) + countNegativesStart events)
                 else countNegativesStart events
  where
    si = sum (inner events)
    inner xs = dropNegativesStart (dropPositivesEnd xs)

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

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  print . (*(-1)) . minimum . scanl1 (+) $ xs

main = do
  _ <- getLine
  xs <- (map read . words) `fmap` getLine
  let f x = if x < 0 then (-1)*x else 0
  print . f . minimum . scanr1 (+) $ xs

module Main where

main = interact readAndSolve

readAndSolve :: String -> String
readAndSolve input = show . solve . convert $ input

convert :: String -> [Int]
convert input = let	numbers = (lines input) !! 1 in
				map read (words numbers)

solve :: [Int] -> Int
solve = abs . minimum . calcPrefixSums

calcPrefixSums :: [Int] -> [Int]
calcPrefixSums = foldLP (+) 0

foldLP :: (a -> b -> a) -> a -> [b] -> [a]
foldLP _ _ [] = []
foldLP f s (x:xs) = let curS = f s x in curS : foldLP f curS xs

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ z [] = z
foldl' f s (x:xs) = foldl' f (f s x)  xs

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x:xs) rr up
  | rr >= 1 = solve xs (rr-1) up
  | otherwise = solve xs rr (up+1)

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x : xs) rr up
  | x == -1   = if rr >= 1 then solve xs (rr - 1) up else solve xs rr (up + 1)
  | otherwise = solve xs (rr + 1) up

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . tail . map read . words

solve :: [Int] -> Int -> Int -> Int
solve [] _ up = up
solve (x:xs) rr up
  | rr >= 1 = solve xs (rr-1) up
  | otherwise = solve xs rr (up+1)

prepare :: [Int] -> Int
prepare crimes = solve crimes 0 0

main :: IO ()
main = interact $ show . prepare . map read .  words


You are given a sequence a consisting of n integers. Find the maximum possible value of  (integer remainder of ai divided by aj), where 1 ≤ i, j ≤ n and ai ≥ aj.

The first line contains integer n — the length of the sequence (1 ≤ n ≤ 2·105).  The second line contains n space-separated integers ai (1 ≤ ai ≤ 106).

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  (m,arr) <- uniqueSort 1000000 n.listArray (0,n-1).map readInt.B.words <$> B.getLine
  print $ solve m arr

solve :: Int -> UArray Int Int -> Int
solve 1 _ = 0
solve n arr = go 0 0
   where
     !ub = unsafeAt arr (n-1)
     go !acc !i
       | i < n = let !ai = unsafeAt arr i
                     step acc q = max acc $ unsafeAt memo (min 1000001 $ (q+1)*ai) - q*ai
                 in go (foldl' step acc [1..ub`quot`ai]) (i+1)
       | otherwise = acc

     !memo = runSTUArray $ do
       memo <- newArray (0,1000001) 0 :: ST s (STUArray s Int Int)

       rep (unsafeAt arr 0+1) $ \i -> do
         unsafeWrite memo i 0
       rep (n-1) $ \i -> do
         let !ai = unsafeAt arr i
         for (ai+1) (unsafeAt arr (i+1)) $ \j -> do
           unsafeWrite memo j ai
       let !lst = unsafeAt arr (n-1)
       for (unsafeAt arr (n-1)+1) 1000001 $ \j -> do
         unsafeWrite memo j lst

       return memo

uniqueSort :: Int -> Int -> UArray Int Int -> (Int, UArray Int Int)
uniqueSort ub n arr = runST $ do
  inArray <- newArray (0,ub) False :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    unsafeWrite inArray (unsafeAt arr i) True

  res <- newArray_ (0,n-1) :: ST s (STUArray s Int Int)

  let go !cnt !i
        | i <= ub = do
            flg <- unsafeRead inArray i
            if flg then unsafeWrite res cnt i >> go (cnt+1) (i+1)
            else go cnt (i+1)
        | otherwise = (,) cnt <$> unsafeFreeze res
  go 0 0

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

upperBound :: (Integral i, Bits i) => (i -> Bool) -> i -> i -> i
upperBound p low high = go low high
   where
     go !low !high
       | low < high = case (low + high + 1) `unsafeShiftR` 1 of
                        mid | p mid -> go mid high
                            | otherwise -> go low (mid-1)
       | otherwise = low
{-# INLINE upperBound #-}

main :: IO ()
main = do
  n <- readLn
  (m,arr) <- uniqueSort 1000000 n.listArray (0,n-1).map readInt.B.words <$> B.getLine
  print $ solve m arr

solve :: Int -> UArray Int Int -> Int
solve 1 _ = 0
solve n arr = go 0 0
   where
     !ub = unsafeAt arr (n-1)
     go !acc !i
       | i < n  = let !ai = unsafeAt arr i
                      step (acc, j) q = (acc',j')
                       where
                         !qai = q * ai
                         !j' = upperBound (\x -> unsafeAt arr x - qai < ai) j $ min (j+ai) (n-1)
                         !acc' = max acc $ unsafeAt arr j' - qai
                  in go (fst $ foldl' step (acc,i) [1..quot ub ai]) (i+1)
       | otherwise = acc

uniqueSort :: Int -> Int -> UArray Int Int -> (Int, UArray Int Int)
uniqueSort ub n arr = runST $ do
  inArray <- newArray (0,ub) False :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    unsafeWrite inArray (unsafeAt arr i) True

  res <- newArray_ (0,n-1) :: ST s (STUArray s Int Int)

  let go !cnt !i
        | i <= ub = do
            flg <- unsafeRead inArray i
            if flg then unsafeWrite res cnt i >> go (cnt+1) (i+1)
            else go cnt (i+1)
        | otherwise = (,) cnt <$> unsafeFreeze res
  go 0 0


There are n banks in the city where Vasya lives, they are located in a circle, such that any two banks are neighbouring if their indices differ by no more than 1. Also, bank 1 and bank n are neighbours if n > 1. No bank is a neighbour of itself.Vasya has an account in each bank. Its balance may be negative, meaning Vasya owes some money to this bank.There is only one type of operations available: transfer some amount of money from any bank to account in any neighbouring bank. There are no restrictions on the size of the sum being transferred or balance requirements to perform this operation.Vasya doesn't like to deal with large numbers, so he asks you to determine the minimum number of operations required to change the balance of each bank account to zero. It's guaranteed, that this is possible to achieve, that is, the total balance of Vasya in all banks is equal to zero.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of banks. The second line contains n integers ai ( - 109 ≤ ai ≤ 109), the i-th of them is equal to the initial balance of the account in the i-th bank. It's guaranteed that the sum of all ai is equal to 0.

Print the minimum number of operations required to change balance in each bank to zero.

NoteIn the first sample, Vasya may transfer 5 from the first bank to the third.In the second sample, Vasya may first transfer 1 from the third bank to the second, and then 1 from the second to the first.In the third sample, the following sequence provides the optimal answer:   transfer 1 from the first bank to the second bank;  transfer 3 from the second bank to the third;  transfer 6 from the third bank to the fourth.

import qualified Data.Map as Map

main :: IO()
main = do
    sn <- getLine
    sa <- getLine
    let n = read sn
    let a = map read $ words sa
    print $ solve n a Map.empty 0 n

removeMaybe :: Maybe Int -> Int
removeMaybe (Just a) = a
removeMaybe Nothing = 0

solve :: Int -> [Integer] -> Map.Map Integer Int -> Integer -> Int -> Int
solve _ [] _ _ ans = ans
solve n (a:ax) cnt sum ans = let next_sum = sum + a
                                 num = 1 + (removeMaybe $ Map.lookup next_sum cnt)
                                 deleted = Map.delete next_sum cnt
                                 next_cnt = Map.insert next_sum num deleted
                             in solve n ax next_cnt next_sum (min ans (n - num))

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Map (elems, empty, lookup, insert)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int -> [Int] -> Int
solve n xs = foldr go (minimum . map snd . elems) ys empty
    where
    ys = zip [0..] . scanl1 (+) . map fromIntegral $ xs ++ xs :: [(Int, Int64)]
    go (i, x) run w = case x `lookup` w of
        Nothing -> run $ insert x (i, 0) w
        Just (k, acc) -> case n < k + 1 of
            True  -> run w
            False -> run $ insert x (i, acc + i - k - 1) w

main = do
    [n] <- parse <$> getLine
    getLine >>= print . solve n . parse

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Map (elems, empty, lookup, insert, adjust)

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: Int -> [Int64] -> Int64
solve n xs = foldr go inf (zip [0..] . scanl1 (+) $ xs ++ xs) empty
    where
    inf = minimum . map snd . elems
    go (i, x) run w = case x `lookup` w of
        Nothing -> run $ insert x (i, 0) w
        Just (k, acc) -> case n < k + 1 of
            True  -> run w
            False -> run $ insert x (i, acc + inc) w
                where inc = fromIntegral $ i - k - 1

main = do
    [n] <- parse <$> getLine
    getLine >>= print . solve n . map fromIntegral . parse

import qualified Data.Map as M

main=interact $ show . solve . map read . words

solve :: [Integer] -> Integer
solve (n:xs) = (n-) . M.foldl max 1 . snd . foldl pref (0, M.empty) . take (fromIntegral n) $ xs

pref (cv, m) a = (nv, if nv `M.member` m then M.adjust succ nv m else M.insert nv 1 m)
  where nv = cv + a

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]
fast_read_Int64 = fmap (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) BS.getLine :: IO [Int64]

citesc_nr :: String -> Int64
citesc_nr s = read s
citesc_array :: [String] -> [Int64]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int64 Int64 -> [(Int64,Int64)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int64
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int64 Int64
    print $ (n-) . foldl max 1 . map snd $ solve dp

import qualified Data.Map as M

main=interact $ show . solve . map read . words

solve (n:xs) = ((n-1)-) . M.foldl max 0 . snd . foldl pref (0, M.empty) . take n $ xs

pref (cv, m) a = (nv, if nv `M.member` m then M.adjust succ nv m else M.insert nv 0 m)
  where nv = cv + a

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

citesc_nr :: String -> Int
citesc_nr s = read s
citesc_array :: [String] -> [Int]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int Int -> [(Int,Int)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int Int
    print $ (n-) . maximum . map snd $ solve dp

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.Map as M
fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

citesc_nr :: String -> Int
citesc_nr s = read s
citesc_array :: [String] -> [Int]
citesc_array = map read

--prefix sums
sumlist' xx = aux xx 0
    where aux [] a = []
          aux (x:xs) a = (a+x) : aux xs (a+x)

--pref m a = (a, if a `M.member` m then M.adjust succ a m else M.insert a 1 m)
f v x = Map.insertWith (+) x 1 v

solve :: Map.Map Int Int -> [(Int,Int)]
solve map_frec = M.toList map_frec

main = do
    x <- getLine
    let n = (citesc_nr x)
    vector <- fast_read_Int
    let ps = sumlist' vector
    let dp = foldl f M.empty ps :: M.Map Int Int
    print $ (n-) . foldl max 1 . map snd $ solve dp


Gianni, SWERC's chief judge, received a huge amount of high quality problems from the judges and now he has to choose a problem set for SWERC.He received $$$n$$$ problems and he assigned a beauty score and a difficulty to each of them. The $$$i$$$-th problem has beauty score equal to $$$b_i$$$ and difficulty equal to $$$d_i$$$. The beauty and the difficulty are integers between $$$1$$$ and $$$10$$$. If there are no problems with a certain difficulty (the possible difficulties are $$$1,2,\dots,10$$$) then Gianni will ask for more problems to the judges.Otherwise, for each difficulty between $$$1$$$ and $$$10$$$, he will put in the problem set one of the most beautiful problems with such difficulty (so the problem set will contain exactly $$$10$$$ problems with distinct difficulties). You shall compute the total beauty of the problem set, that is the sum of the beauty scores of the problems chosen by Gianni.

Each test contains multiple test cases. The first line contains an integer $$$t$$$ ($$$1\le t\le 100$$$) — the number of test cases. The descriptions of the $$$t$$$ test cases follow. The first line of each test case contains the integer $$$n$$$ ($$$1\le n\le 100$$$) — how many problems Gianni received from the judges. The next $$$n$$$ lines contain two integers each. The $$$i$$$-th of such lines contains $$$b_i$$$ and $$$d_i$$$ ($$$1\le b_i, d_i\le 10$$$) — the beauty score and the difficulty of the $$$i$$$-th problem.

For each test case, print the total beauty of the problem set chosen by Gianni. If Gianni cannot create a problem set (because there are no problems with a certain difficulty) print the string MOREPROBLEMS (all letters are uppercase, there are no spaces).

NoteIn the first test case, Gianni has received only $$$3$$$ problems, with difficulties $$$3, 4, 7$$$ which are not sufficient to create a problem set (for example because there is not a problem with difficulty $$$1$$$).In the second test case, Gianni will create a problem set by taking the problems $$$2$$$, $$$3$$$, $$$4$$$, $$$5$$$, $$$7$$$, $$$8$$$, $$$9$$$, $$$10$$$, $$$11$$$ (which have beauty equal to $$$10$$$ and all difficulties from $$$1$$$ to $$$9$$$) and one of the problems $$$1$$$ and $$$6$$$ (which have both beauty $$$3$$$ and difficulty $$$10$$$). The total beauty of the resulting problem set is $$$10\cdot 9 + 3 = 93$$$.

import Control.Monad
  ( replicateM
  , replicateM_
  )
import qualified Data.Map as Map

solve :: [[Int]] -> Maybe Int
solve problems =
  let
    r = iter Map.empty problems
  in
    if Map.size r == 10
      then Just $ Map.foldl' (+) 0 r
      else Nothing
  where
    iter :: Map.Map Int Int -> [[Int]] -> Map.Map Int Int
    iter prev [] = prev
    iter prev (p:rem) =
      let
        b = head p
        d = head $ tail p
        curr = if Map.member d prev
          then Map.update (Just . max b) d prev
          else Map.insert d b prev
      in iter curr rem

main :: IO ()
main = do
  tc <- readInt <$> getLine
  replicateM_ tc gao
  where
    readInt s = read s :: Int
    gao = do
      n <- readInt <$> getLine
      problems <- replicateM n ((map readInt . words) <$> getLine)
      case solve problems of
        Just result -> print result
        _ -> putStrLn "MOREPROBLEMS"


Consider a sequence of integers $$$a_1, a_2, \ldots, a_n$$$. In one move, you can select any element of the sequence and delete it. After an element is deleted, all elements to the right are shifted to the left by $$$1$$$ position, so there are no empty spaces in the sequence. So after you make a move, the sequence's length decreases by $$$1$$$. The indices of the elements after the move are recalculated.E. g. let the sequence be $$$a=[3, 2, 2, 1, 5]$$$. Let's select the element $$$a_3=2$$$ in a move. Then after the move the sequence will be equal to $$$a=[3, 2, 1, 5]$$$, so the $$$3$$$-rd element of the new sequence will be $$$a_3=1$$$ and the $$$4$$$-th element will be $$$a_4=5$$$.You are given a sequence $$$a_1, a_2, \ldots, a_n$$$ and a number $$$k$$$. You need to find the minimum number of moves you have to make so that in the resulting sequence there will be at least $$$k$$$ elements that are equal to their indices, i. e. the resulting sequence $$$b_1, b_2, \ldots, b_m$$$ will contain at least $$$k$$$ indices $$$i$$$ such that $$$b_i = i$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of two consecutive lines. The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2000$$$). The second line contains a sequence of integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$). The numbers in the sequence are not necessarily different. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2000$$$.

For each test case output in a single line:   $$$-1$$$ if there's no desired move sequence;  otherwise, the integer $$$x$$$ ($$$0 \le x \le n$$$) — the minimum number of the moves to be made so that the resulting sequence will contain at least $$$k$$$ elements that are equal to their indices.

NoteIn the first test case the sequence doesn't satisfy the desired condition, but it can be provided by deleting the first element, hence the sequence will be $$$[1, 2, 3, 4, 5, 6]$$$ and $$$6$$$ elements will be equal to their indices.In the second test case there are two ways to get the desired result in $$$2$$$ moves: the first one is to delete the $$$1$$$-st and the $$$3$$$-rd elements so that the sequence will be $$$[1, 2, 3]$$$ and have $$$3$$$ elements equal to their indices; the second way is to delete the $$$2$$$-nd and the $$$3$$$-rd elements to get the sequence $$$[5, 2, 3]$$$ with $$$2$$$ desired elements.

import Control.Monad (replicateM_)
import Data.Array ((!))
import qualified Data.Array as A

-- Based on the solution by Newtech66
type IntArray = A.Array Int Int
inf = 3000

maxFixed :: IntArray -> IntArray
maxFixed a = dp where
  (_, n) = A.bounds a
  init = if a!1 == 1 then (1, 1) else (1, -inf)
  checkRemoved i j = j - a!j <= i - a!i
  checkSpace i j = a!i > a!j -- (i - a!i) - (j - a!j) <= i - j - 1
  findMax i dp = if a!i > i then -inf else maximum $ 1 : [dp!j + 1 |
      j <- [1..i-1],
      dp!j > 0 && checkRemoved i j && checkSpace i j
    ]
  dp = A.array (1,n) $ init : [(i, findMax i dp) | i <- [2..n]]

minOps :: Int -> IntArray -> Int
minOps k a = if null removedElems then -1 else minimum removedElems where
  (_, n) = A.bounds a
  dp = maxFixed a
  removedElems = [i - a!i | i <- [1..n], dp!i >= k]

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

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    [n, k] <- readInts
    a <- A.array (1,n) . zip [1..] <$> readInts
    print $ minOps k a


$$$n$$$ people gathered to hold a jury meeting of the upcoming competition, the $$$i$$$-th member of the jury came up with $$$a_i$$$ tasks, which they want to share with each other.First, the jury decides on the order which they will follow while describing the tasks. Let that be a permutation $$$p$$$ of numbers from $$$1$$$ to $$$n$$$ (an array of size $$$n$$$ where each integer from $$$1$$$ to $$$n$$$ occurs exactly once).Then the discussion goes as follows:  If a jury member $$$p_1$$$ has some tasks left to tell, then they tell one task to others. Otherwise, they are skipped.  If a jury member $$$p_2$$$ has some tasks left to tell, then they tell one task to others. Otherwise, they are skipped.  ...  If a jury member $$$p_n$$$ has some tasks left to tell, then they tell one task to others. Otherwise, they are skipped.  If there are still members with tasks left, then the process repeats from the start. Otherwise, the discussion ends. A permutation $$$p$$$ is nice if none of the jury members tell two or more of their own tasks in a row. Count the number of nice permutations. The answer may be really large, so print it modulo $$$998\,244\,353$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of the test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — number of jury members. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the number of problems that the $$$i$$$-th member of the jury came up with. The sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print one integer — the number of nice permutations, taken modulo $$$998\,244\,353$$$.

NoteExplanation of the first test case from the example:There are two possible permutations, $$$p = [1, 2]$$$ and $$$p = [2, 1]$$$. For $$$p = [1, 2]$$$, the process is the following:  the first jury member tells a task;  the second jury member tells a task;  the first jury member doesn't have any tasks left to tell, so they are skipped;  the second jury member tells a task. So, the second jury member has told two tasks in a row (in succession), so the permutation is not nice.For $$$p = [2, 1]$$$, the process is the following:  the second jury member tells a task;  the first jury member tells a task;  the second jury member tells a task. So, this permutation is nice.

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C
-- Failed to solve on my own and saw the editorial :/

import Control.Monad

-- bytestring for fast IO
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int64
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int64]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ (fromIntegral t) solve

magic = 998244353
mul2 x y = (x * y) `mod` magic

{- NOTE on Int64
 -
 - It's strange but when I use just Int type, codeforces and my desktop give different results for the input:
 - n = 74
 - as = 9 3 10 8 6 6 1 6 9 3 7 3 2 8 1 5 8 4 6 4 1 6 5 6 10 3 6 6 6 4 9 5 8 7 2 1 6 2 4 9 10 9 5 4 7 5 7 2 10 10 1 5 2 4 1 7 7 3 8 10 2 5 8 4 3 9 2 9 9 8 6 8 4 5
 - The answer is 420779088 and my desktop gives that number but codeforces gives 939628924.
 - Switching every Int to Int64 fixes the problem but I don't know why? Even the solution in the editorial uses int, not int64_t.
 -}
solve = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = fromIntegral $ length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int64
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int64]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ (fromIntegral t) (solve (t == 1000))

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve dbg = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = fromIntegral $ length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer
    {-
    if dbg then do
        putStrLn "=== debug ==="
        putStrLn ("maxima: " ++ show maxima)
        putStrLn ("k: " ++ show k)
        putStrLn ("maxima_count: " ++ show maxima_count)
        putStrLn ("x: " ++ show x)
        putStrLn ("y: " ++ show y)
    else do
        return ()
        -}

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = numberOf int

-- output :: Output -> C.ByteString
output = showB

-- solve :: Input -> Output
solve xs
  | f /= 1 = factorial ! n
  | otherwise = factorial ! n *% (fi g /% fi (f + g))
  where
    n = length xs
    m = maximum xs
    f = count m xs
    g = count (m - 1) xs

maxn :: (Integral a) => a
maxn = 2 * 10 ^ 5 + 5

factorial :: UArray Int Int64
factorial = listArray (0, maxn) $ scanl (*%) 1 [1 .. maxn]

modv :: Int64
modv = 998244353

(*%), (/%) :: Int64 -> Int64 -> Int64
u *% v = (u * v) `mod` modv
u /% v = u *% modInv v

modInv :: Int64 -> Int64
modInv a = modPow a (modv - 2)

modPow :: Int64 -> Int64 -> Int64
modPow a n
  | n == 0 = 1
  | odd n = a *% modPow a (n - 1)
  | otherwise = let a' = modPow a (n `div` 2) in a' *% a'

-------------------------- Template ------------------------------------------
fi = fromIntegral

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Control.Monad
import Data.Array
import Data.Int

m :: Int64
m = 998244353

newtype MInt = MInt {toInt64 :: Int64}

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

instance Enum MInt where
    toEnum = fromIntegral
    fromEnum = fromIntegral . toInt64

inv :: MInt -> MInt
inv a = a ^ (m - 2)

fac :: Array Int MInt
fac = listArray (0, 2 * 10^5) xs where xs = 1 : zipWith (*) [1..] xs

solve :: IO ()
solve = do
    n <- readLn
    as <- readMany
    let m = maximum as
        mc = length $ filter (==m) as
        bs = filter (/=m) as
        m' = maximum bs
        mc'= length $ filter (==m') bs
        res | mc > 1     = fac!n
            | m - m' > 1 = 0
            | otherwise  = fac!mc' * fromIntegral mc' * fac!n * inv (fac!(mc' + 1))
    print $ toInt64 res

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solve

import Control.Monad
import Data.Array
import Data.Int

m :: Int64
m = 998244353

newtype MInt = MInt {toInt64 :: Int64} deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

instance Enum MInt where
    toEnum = fromIntegral
    fromEnum = fromIntegral . toInt64

inv :: MInt -> MInt
inv a = a ^ (m - 2)

lim :: Int
lim = 5 * 10^5

fac :: Array Int MInt
fac = listArray (0, lim) xs where xs = 1 : zipWith (*) [1..] xs

binomMod :: Int -> Int -> MInt
binomMod = ch where
    ifac = listArray (0, lim) $ map inv $ elems fac
    ch a b | b < 0 || a < b = 0
    ch a b = fac!a * ifac!b * ifac!(a - b)

solve :: IO ()
solve = do
    n <- readLn
    as <- readMany
    let m = maximum as
        mc = length $ filter (==m) as
        bs = filter (/=m) as
        m' = maximum bs
        mc' = length $ filter (==m') bs
        res | mc > 1 = fac!n
            | m - m' > 1 = 0
            | otherwise = fac!mc' * fromIntegral mc' * fac!(n - mc' - 1) * binomMod n (mc' + 1)
    print $ toInt64 res

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solve

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

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

p :: Int64
p = 998244353

(*!) :: Int64 -> Int64 -> Int64
infixr 7 *!
x *! y = rem (x * y) p

newtype ModP = ModP { unModP :: Int64 }
instance  Semigroup ModP  where
  ModP x <> ModP y = ModP $ x *! y
inv :: Int64 -> Int64
inv = unModP . stimes (p - 2) . ModP

factorial :: Int64 -> Int64
factorial n = foldl' (*!) 1 [1 .. n]

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      x : y : _ = reverse $ sort a
      opts = filter (>= y) a
      k = fromIntegral $ length opts
      n64 = fromIntegral n
      ans = case  x - y  of
        0 -> factorial n64
        1 -> factorial n64 *! (k - 1) *! inv k
        _ -> 0
    pure $ putInt64s [ans]

type SP = State [P.ByteString]
type SO = SP Builder

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

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

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

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

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ t (solve (t == 1000))

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve dbg = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer
    if dbg then do
        putStrLn "=== debug ==="
        putStrLn ("maxima: " ++ show maxima)
        putStrLn ("k: " ++ show k)
        putStrLn ("maxima_count: " ++ show maxima_count)
        putStrLn ("x: " ++ show x)
        putStrLn ("y: " ++ show y)
    else do
        return ()

-- ID  : 1569C (C. Jury Meeting)
-- URL : https://codeforces.com/contest/1569/problem/C

import Control.Monad

-- bytestring for fast IO
import Data.Maybe
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
getInt = parseInt `fmap` BS8.getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fromIntegral . fst . fromJust . BS8.readInt

main = do
    t <- getInt
    replicateM_ t solve

magic = 998244353
mul2 x y = (x * y) `mod` magic

solve = do
    n <- getInt
    as <- getInts
    let maxima = maximum as
    let k = length $ filter (== (maxima - 1)) as
    let maxima_count = length $ filter (== maxima) as
    let x = foldl1 mul2 [1..n]
    let y = foldl1 mul2 [m | m <- [1..n], m /= (k + 1)]
    let answer = if maxima_count == 1 then (x - y + magic) `mod` magic else x
    print answer

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = numberOf int

-- output :: Output -> C.ByteString
output = showB

-- solve :: Input -> Output
solve xs
  | f == n = factorial ! n
  | g == 0 = 0
  | otherwise =
    let pick = fi g /% fi (f + g)
     in factorial ! n *% pick
  where
    n = length xs
    m = maximum xs
    f = count m xs
    g = count (m - 1) xs

factorial :: UArray Int Int64
factorial = listArray (0, 10 ^ 5) $ scanl (*%) 1 [1 .. 10 ^ 5]

modv :: Int64
modv = 998244353

(*%), (/%) :: Int64 -> Int64 -> Int64
u *% v = (u * v) `mod` modv
u /% v = u *% modInv v

modInv :: Int64 -> Int64
modInv a = modPow a (modv - 2)

modPow :: Int64 -> Int64 -> Int64
modPow a n
  | n == 0 = 1
  | odd n = a *% modPow a (n - 1)
  | otherwise = let a' = modPow a (n `div` 2) in a' *% a'

-------------------------- Template ------------------------------------------
fi = fromIntegral

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


There is a polyline going through points (0, 0) – (x, x) – (2x, 0) – (3x, x) – (4x, 0) – ... - (2kx, 0) – (2kx + x, x) – .... We know that the polyline passes through the point (a, b). Find minimum positive value x such that it is true or determine that there is no such x.

Only one line containing two positive integers a and b (1 ≤ a, b ≤ 109).

Output the only line containing the answer. Your answer will be considered correct if its relative or absolute error doesn't exceed 10 - 9. If there is no such x then output  - 1 as the answer.

NoteYou can see following graphs for sample 1 and sample 3.

-- Codeforces 578A

main :: IO ()
main = getLine >>= print . solve . map read . words where
    solve :: (RealFrac a) => [a] -> a
    solve [x, y]
        | x < y = -1
        | otherwise = (x+y)/2/(fromIntegral ((fromIntegral $ floor (x+y)) `div` (fromIntegral $ floor (2*y))))

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | x == -1   = fromRational y
    | y == -1   = fromRational x
    | otherwise = fromRational $ min x y
    where
    x = if k < 0 then -1 else if k == 0 then a % 1 else (a - b) % (2 * k)
        where k = floor $ (a - b) % (2 * b)

    y = if k < 1 then -1 else (a + b) % (2 * k)
        where k = floor $ (a + b) % (2 * b)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b

answer a b = (a+b)/(2*kb+2)
  where k = floor (((a/b)-1.0)/2.0)
        kb = (fromIntegral k)::Double

main = do
  w <- getLine
  let [a,b] = [read n::Double| n <- (words w)]
  if a < b
  then putStrLn "-1"
  else putStrLn $ show $ answer a b

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | a == b    = fromInteger a
    | k < 1 || x == 0 && y == 0 = -1
    | x == 0    = fromRational y
    | y == 0    = fromRational x
    | otherwise = fromRational $ min x y
    where
    k = floor $ (a - b) % (2 * b)
    x = (a - b) % (2 * k)
    y = (a + b) % (2 * k + 2)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b

import Data.Ratio ((%))
import Control.Applicative ((<$>))

solve :: Integer -> Integer -> Double
solve a b
    | k < 1 || x == 0 && y == 0 = -1
    | x == 0    = fromRational y
    | y == 0    = fromRational x
    | otherwise = fromRational $ min x y
    where
    k = floor $ (a - b) % (2 * b)
    x = (a - b) % (2 * k)
    y = (a + b) % (2 * k + 2)

main = do
    a:b:_ <- map read . words <$> getLine
    print $ solve a b


Hamed has recently found a string t and suddenly became quite fond of it. He spent several days trying to find all occurrences of t in other strings he had. Finally he became tired and started thinking about the following problem. Given a string s how many ways are there to extract k ≥ 1 non-overlapping substrings from it such that each of them contains string t as a substring? More formally, you need to calculate the number of ways to choose two sequences a1, a2, ..., ak and b1, b2, ..., bk satisfying the following requirements:  k ≥ 1          t is a substring of string saisai + 1... sbi (string s is considered as 1-indexed). As the number of ways can be rather large print it modulo 109 + 7.

Input consists of two lines containing strings s and t (1 ≤ |s|, |t| ≤ 105). Each string consists of lowercase Latin letters.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Unsafe as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

type Index = Int
type Rank = Int
type SuffixArray = UArray Int Int

suffixArray :: B.ByteString -> UArray Int Int
suffixArray bs = runSTUArray $ do
  let !n = B.length bs :: Int
      !countMax = max 0xff (n+1)

  sa    <- newArray (0,n) 0 :: ST s (STUArray s Int Int)
  rank  <- newArray (0,n) 0 :: ST s (STUArray s Int Int)
  tmp   <- newArray (0,n) 0 :: ST s (STUArray s Int Int)
  count <- newArray (0,countMax) 0 :: ST s (STUArray s Int Int)

  rep n $ \i-> do
    unsafeWrite sa i i
    unsafeWrite rank i . fromIntegral $ B.unsafeIndex bs i
  unsafeWrite sa n n
  unsafeWrite rank n 1

  forM_ (takeWhile (<=n) $ iterate (2*) 1) $ \k-> do
    -- sort sa
    rep (countMax+1) $ \i-> do
      unsafeWrite count i 0
    rep (n+1) $ \i-> do
      sai <- unsafeRead sa i
      if sai+k<=n then do
        rankik <- unsafeRead rank (sai+k)
        unsafeModify count rankik (1+)
      else unsafeModify count 0 (1+)
    rep countMax $ \i-> do
      cnti <- unsafeRead count i
      unsafeModify count (i+1) (cnti+)
    rev (n+1) $ \i-> do
      sai <- unsafeRead sa i
      rankik <- if sai + k <= n then do
                   unsafeRead rank (sai+k)
                else return 0
      j <- subtract 1 <$> unsafeRead count rankik
      unsafeWrite count rankik j
      unsafeRead sa i>>=unsafeWrite tmp j

    rep (countMax+1) $ \i-> do
      unsafeWrite count i 0
    rep (n+1) $ \i-> do
      sai <- unsafeRead tmp i
      ranki <- unsafeRead rank sai
      unsafeModify count ranki (1+)
    rep countMax $ \i-> do
      cnti <- unsafeRead count i
      unsafeModify count (i+1) (cnti+)
    rev (n+1) $ \i-> do
      sai <- unsafeRead tmp i
      ranki <- unsafeRead rank sai
      j <- subtract 1 <$> unsafeRead count ranki
      unsafeWrite count ranki j
      unsafeWrite sa j sai

    -- update rank
    sa0 <- unsafeRead sa 0
    unsafeWrite tmp sa0 1
    rep n $ \i-> do
      sai <- unsafeRead sa i
      sai1 <- unsafeRead sa (i+1)
      ranki <- unsafeRead rank sai
      ranki1 <- unsafeRead rank sai1
      if ranki == ranki1 then do
           rankik  <- if sai  + k > n then return (-1)
                      else unsafeRead rank (sai+k)
           ranki1k <- if sai1 + k > n then return (-1)
                      else unsafeRead rank (sai1+k)
           if rankik == ranki1k then do
             unsafeRead tmp sai >>= unsafeWrite tmp sai1
           else do
             unsafeRead tmp sai >>= unsafeWrite tmp sai1 . (1+)
      else do
        unsafeRead tmp sai >>= unsafeWrite tmp sai1 . (1+)

    rep (n+1) $ \i-> do
      unsafeRead tmp i >>= unsafeWrite rank i

  return sa

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

upperBound :: (Integral i) => (i -> Bool) -> i -> i -> i
upperBound p low high = assert (low>=0 && p low) $ go low high
   where
     go !low !high
       | high <= low = low
       | p mid       = go mid high
       | otherwise   = go low (mid - 1)
      where
        mid = (low + high + 1) `quot` 2
{-# INLINE upperBound #-}

type IntMod = Int64

modulus :: IntMod
modulus = 1000000007

infixl 7 *%
infixl 6 +%, -%

(+%), (-%), (*%) :: IntMod -> IntMod -> IntMod
x +% y = case x + y of xy -> if xy < modulus then xy else xy - modulus
x -% y = case x - y of xy -> if xy >= 0 then xy else xy + modulus
x *% y = x * y `rem` modulus
{-# INLINE (+%) #-}
{-# INLINE (-%) #-}
{-# INLINE (*%) #-}

main :: IO ()
main = do
  s <- B.filter (\c->'a'<=c&&c<='z') <$> B.getLine
  t <- B.filter (\c->'a'<=c&&c<='z') <$> B.getLine
  print $ solve s t

solve :: B.ByteString -> B.ByteString -> IntMod
solve s t
  | B.length t > B.length s = 0
  | l == len || not (B.isPrefixOf t $ B.drop (unsafeAt sa (l+1)) s) = 0
  | otherwise = solve' s t sa (l+1)
   where
     !sa = suffixArray s
     !len = B.length s
     !l = upperBound (\i-> B.drop (unsafeAt sa i) s < t) 0 (B.length s)

solve' :: B.ByteString -> B.ByteString -> SuffixArray -> Int -> IntMod
solve' s t sa l = runST $ do
  let !r = upperBound (\i->B.isPrefixOf t $ B.drop (unsafeAt sa i) s) l (B.length s)

  dp     <- newArray (0,B.length s) 0 :: ST s (STUArray s Int IntMod)
  sumDP  <- newArray (0,B.length s) 0 :: ST s (STUArray s Int IntMod)
  sumDP' <- newArray (0,B.length s) 0 :: ST s (STUArray s Int IntMod)
  flags  <- newArray (0,B.length s) False :: ST s (STUArray s Int Bool)

  let !lenT = B.length t

  let (i0:is) = sort $ map (unsafeAt sa) [l..r]

  unsafeWrite dp (i0+lenT-1) $ fromIntegral (i0+1)
  unsafeWrite sumDP (i0+lenT-1) $ fromIntegral (i0+1)
  unsafeWrite sumDP' (i0+lenT-1) $ fromIntegral (i0+1)

  forM_ (i0:is) $ \i -> do
    unsafeWrite flags i True

  for (i0+lenT) (B.length s-1) $ \bk -> do
    let akmax = bk - lenT + 1
    flg <- unsafeRead flags akmax

    if flg  then do
      dpi <- (fromIntegral akmax+%1+%) <$> unsafeRead sumDP' (akmax-1)
      si <- (dpi+%) <$> unsafeRead sumDP (bk-1)
      unsafeWrite dp bk dpi
      unsafeWrite sumDP bk si
      unsafeRead sumDP' (bk-1) >>= unsafeWrite sumDP' bk . (si+%)
    else do
      dpi <- unsafeRead dp (bk-1)
      unsafeWrite dp bk dpi
      si <- (dpi+%) <$> unsafeRead sumDP (bk-1)
      unsafeWrite sumDP bk si
      unsafeRead sumDP' (bk-1) >>= unsafeWrite sumDP' bk .(si+%)
  (`mod` modulus) <$> unsafeRead sumDP (B.length s-1)


Leo has developed a new programming language C+=. In C+=, integer variables can only be changed with a "+=" operation that adds the right-hand side value to the left-hand side variable. For example, performing "a += b" when a = $$$2$$$, b = $$$3$$$ changes the value of a to $$$5$$$ (the value of b does not change).In a prototype program Leo has two integer variables a and b, initialized with some positive values. He can perform any number of operations "a += b" or "b += a". Leo wants to test handling large integers, so he wants to make the value of either a or b strictly greater than a given value $$$n$$$. What is the smallest number of operations he has to perform?

The first line contains a single integer $$$T$$$ ($$$1 \leq T \leq 100$$$) — the number of test cases. Each of the following $$$T$$$ lines describes a single test case, and contains three integers $$$a, b, n$$$ ($$$1 \leq a, b \leq n \leq 10^9$$$) — initial values of a and b, and the value one of the variables has to exceed, respectively.

For each test case print a single integer — the smallest number of operations needed. Separate answers with line breaks.

NoteIn the first case we cannot make a variable exceed $$$3$$$ in one operation. One way of achieving this in two operations is to perform "b += a" twice.

import Control.Monad

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

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

solve :: Int -> Int -> Int -> Int
solve a b n = f a' b' n
  where
    a' = min a b
    b' = max a b
    f x y m
      | y>m = 0
      | otherwise = 1 + f y (x+y) m

{-# LANGUAGE TypeApplications #-}

import           Control.Monad
import           Control.Applicative
import           Data.List
import           Data.Char
import           Control.Arrow
import           Data.Bits

main = (>>=) (readLn @Int) $ flip replicateM_ $ do
  [a, b, n] <- map (read @Int) . words <$> getLine
  print $ solve a b n 0
 where
  solve a b n k | a > n || b > n = k
                | otherwise      = solve (max a b) (a + b) n (k + 1)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Tuple

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

-- assuming x <= y
_solve !acc !x !y tgt
  | y > tgt = acc
  | otherwise = _solve (acc + 1) y (x+y) tgt
solve x y tgt = _solve 0 (min x y) (max x y) tgt

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = tokens |> unfoldr (\case
        []  -> Nothing
        a:b:n:rest  -> Just (solve a b n, rest)
        )
  sequence_ $ putStrLn <$> (show <$> res)

import Control.Applicative
import Control.Monad

parse :: [String] -> [[Integer]]
parse = map (\l -> map read . words $ l)

solve :: [Integer] -> Integer
solve (a:b:n:[])
  | a>n || b>n = 0
  | a<=b = 1 +  solve [(a+b), b, n]
  | otherwise = 1 + solve [a, (a+b), n]

main :: IO ()
main = do
  n <- getLine
  content <- replicateM (read n :: Int) getLine
  putStrLn . unlines . map show . map solve . parse $ content

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

process s n m k | n>k || m>k = s
                | n<m = process (s+1) (n+m) m k
                | otherwise = process (s+1) n (m+n) k

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

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

import Control.Monad

brute :: Int->Int->Int->Int->Int
brute a b n acc
  | a > n || b > n = acc
  | a > b = brute a (b + a) n (acc + 1)
  | otherwise = brute (a + b) b n (acc + 1)

solveTest = do
  [a, b, n] <- (map read) . words <$>getLine
  putStrLn . show $ brute a b n 0

main = do
  t <- read <$> getLine
  replicateM_ t solveTest


There are $$$n$$$ chests. The $$$i$$$-th chest contains $$$a_i$$$ coins. You need to open all $$$n$$$ chests in order from chest $$$1$$$ to chest $$$n$$$.There are two types of keys you can use to open a chest:   a good key, which costs $$$k$$$ coins to use;  a bad key, which does not cost any coins, but will halve all the coins in each unopened chest, including the chest it is about to open. The halving operation will round down to the nearest integer for each chest halved. In other words using a bad key to open chest $$$i$$$ will do $$$a_i = \lfloor{\frac{a_i}{2}\rfloor}$$$, $$$a_{i+1} = \lfloor\frac{a_{i+1}}{2}\rfloor, \dots, a_n = \lfloor \frac{a_n}{2}\rfloor$$$;  any key (both good and bad) breaks after a usage, that is, it is a one-time use. You need to use in total $$$n$$$ keys, one for each chest. Initially, you have no coins and no keys. If you want to use a good key, then you need to buy it.During the process, you are allowed to go into debt; for example, if you have $$$1$$$ coin, you are allowed to buy a good key worth $$$k=3$$$ coins, and your balance will become $$$-2$$$ coins.Find the maximum number of coins you can have after opening all $$$n$$$ chests in order from chest $$$1$$$ to chest $$$n$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \leq n \leq 10^5$$$; $$$0 \leq k \leq 10^9$$$) — the number of chests and the cost of a good key respectively. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$0 \leq a_i \leq 10^9$$$)  — the amount of coins in each chest. The sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case output a single integer  — the maximum number of coins you can obtain after opening the chests in order from chest $$$1$$$ to chest $$$n$$$. Please note, that the answer for some test cases won't fit into 32-bit integer type, so you should use at least 64-bit integer type in your programming language (like long long for C++).

NoteIn the first test case, one possible strategy is as follows:   Buy a good key for $$$5$$$ coins, and open chest $$$1$$$, receiving $$$10$$$ coins. Your current balance is $$$0 + 10 - 5 = 5$$$ coins.  Buy a good key for $$$5$$$ coins, and open chest $$$2$$$, receiving $$$10$$$ coins. Your current balance is $$$5 + 10 - 5 = 10$$$ coins.  Use a bad key and open chest $$$3$$$. As a result of using a bad key, the number of coins in chest $$$3$$$ becomes $$$\left\lfloor \frac{3}{2} \right\rfloor = 1$$$, and the number of coins in chest $$$4$$$ becomes $$$\left\lfloor \frac{1}{2} \right\rfloor = 0$$$. Your current balance is $$$10 + 1 = 11$$$.  Use a bad key and open chest $$$4$$$. As a result of using a bad key, the number of coins in chest $$$4$$$ becomes $$$\left\lfloor \frac{0}{2} \right\rfloor = 0$$$. Your current balance is $$$11 + 0 = 11$$$.  At the end of the process, you have $$$11$$$ coins, which can be proven to be maximal.

import Control.Monad
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map

solve :: [Int] -> Int -> Int -> Int
solve arr n k =
    solve' arr n k 0 0 0

solve' [] n k i curSum acc =
    if acc > me then acc else me
    where me = curSum - n * k

solve' arr n k i curSum acc =
    solve' (tail arr) n k (i+1) (curSum + (head arr)) mx
    where
        elems = zip [1..] $ take 32 arr
        halve = \(i, v) -> v `div` (2 ^ i)
        me = curSum + (sum $ map halve elems) - k * i
        mx = if me > acc then me else acc

testcase 0 = return ()
testcase t = do
    (n:k:_) <- map (read :: String -> Int) <$> words <$> getLine
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n k
    testcase (t - 1)

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

import Control.Monad
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map

solve :: [Int] -> Int -> Int -> Int
solve arr n k =
    solve' arr n k 0 0

solve' [] n k i curSum = curSum - n * k
solve' arr n k i curSum =
    (if me - i * k > you
    then me - i * k
    else you)
    where
        elems = zip [1..] $ take 32 arr
        halve = \(i, v) -> v `div` (2 ^ i)
        me = curSum + (sum $ map halve elems)
        you = solve' (tail arr) n k (i+1) (curSum + (head arr))

testcase 0 = return ()
testcase t = do
    (n:k:_) <- map (read :: String -> Int) <$> words <$> getLine
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n k
    testcase (t - 1)

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

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate, transpose)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

-- road map in reverse, and the number of cities, init pen state
type Domain = ([Int], Int)
type CoDomain = Int
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ show xs

parse :: IO Domain
parse = do
  [n, k] <- readChar8
  xs <- readChar8
  return (xs, k)

compute :: [Int] -> Int
compute ys = go 1 ys
  where
    go :: Int -> [Int] -> Int
    go _ [] = 0
    go n (x:xs)
     | n > 31 = 0
     | otherwise = x `div` 2 ^ n + go (n+1) xs

solve :: Solver
solve (xs, k) = ans
  where
        yss = zipWith (flip (-) . (k*)) [0..] $ scanl (+) 0 xs
        rss = compute <$> scanr (:) [] xs
        ans = maximum $ zipWith (+) rss yss

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n $ printAns =<< solve <$> parse
  return ()