There are $$$n$$$ pillars aligned in a row and numbered from $$$1$$$ to $$$n$$$.Initially each pillar contains exactly one disk. The $$$i$$$-th pillar contains a disk having radius $$$a_i$$$.You can move these disks from one pillar to another. You can take a disk from pillar $$$i$$$ and place it on top of pillar $$$j$$$ if all these conditions are met:  there is no other pillar between pillars $$$i$$$ and $$$j$$$. Formally, it means that $$$|i - j| = 1$$$;  pillar $$$i$$$ contains exactly one disk;  either pillar $$$j$$$ contains no disks, or the topmost disk on pillar $$$j$$$ has radius strictly greater than the radius of the disk you move. When you place a disk on a pillar that already has some disks on it, you put the new disk on top of previously placed disks, so the new disk will be used to check the third condition if you try to place another disk on the same pillar.You may take any disk and place it on other pillar any number of times, provided that every time you do it, all three aforementioned conditions are met. Now you wonder, is it possible to place all $$$n$$$ disks on the same pillar simultaneously?

The first line contains one integer $$$n$$$ ($$$3 \le n \le 2 \cdot 10^5$$$) — the number of pillars. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_i$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the radius of the disk initially placed on the $$$i$$$-th pillar. All numbers $$$a_i$$$ are distinct.

Print YES if it is possible to place all the disks on the same pillar simultaneously, and NO otherwise. You may print each letter in any case (YES, yes, Yes will all be recognized as positive answer, NO, no and nO will all be recognized as negative answer).

NoteIn the first case it is possible to place all disks on pillar $$$3$$$ using the following sequence of actions:  take the disk with radius $$$3$$$ from pillar $$$2$$$ and place it on top of pillar $$$3$$$;  take the disk with radius $$$1$$$ from pillar $$$1$$$ and place it on top of pillar $$$2$$$;  take the disk with radius $$$2$$$ from pillar $$$4$$$ and place it on top of pillar $$$3$$$;  take the disk with radius $$$1$$$ from pillar $$$2$$$ and place it on top of pillar $$$3$$$.

{-# OPTIONS_GHC -O2 #-}

import Data.Char (ord)
import Data.List (sort, group)

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

parseInts = fmap parseInt . words

main = do
  n <- fmap parseInt getLine
  a <- fmap parseInts getLine
  let left = increase 1 a
      right = increase 1 (reverse a)
      increase l [a] = l
      increase l (a:a':as)
        | a < a' = increase (l + 1) (a' : as)
        | otherwise = l
      bl = length . group . sort $ a
      al = length a
  if left + right > al && bl == al
    then putStrLn "YES"
    else putStrLn "NO"


Yash has recently learnt about the Fibonacci sequence and is very excited about it. He calls a sequence Fibonacci-ish if   the sequence consists of at least two elements  f0 and f1 are arbitrary  fn + 2 = fn + 1 + fn for all n ≥ 0. You are given some sequence of integers a1, a2, ..., an. Your task is rearrange elements of this sequence in such a way that its longest possible prefix is Fibonacci-ish sequence.

The first line of the input contains a single integer n (2 ≤ n ≤ 1000) — the length of the sequence ai. The second line contains n integers a1, a2, ..., an (|ai| ≤ 109).

Print the length of the longest possible Fibonacci-ish prefix of the given sequence after rearrangement.

NoteIn the first sample, if we rearrange elements of the sequence as  - 1, 2, 1, the whole sequence ai would be Fibonacci-ish.In the second sample, the optimal way to rearrange elements is , , , , 28.

import           Control.Monad
import           Data.List
import           Control.Arrow
import           Data.Array
import qualified Data.Map.Strict               as Map
import           Data.Either
import           Data.Int
import           Data.Ord

($$) = flip ($)

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

readInt :: IO Int
readInt = read <$> getLine

main :: IO ()
main = do
    _  <- readInt
    as <- readInts
    let cnts = sort as $$ group $$ map (head &&& length) $$ Map.fromList
    -- print cnts
    print $ maxFib cnts

-- maxFib :: Map.Map Int Int -> (Int, Int, Int, [Int])
maxFib cnts =
    (\xs -> if null xs then 1 else maximum xs)
        $ lefts
        $ [ foldM
                (\(mp, l) v ->
                    if Map.member v cnts && Map.findWithDefault 0 v mp < cnts Map.! v
                        then Right (Map.insertWith (+) v 1 mp, l + 1)
                        else Left l
                )
                (Map.empty, 0)
            $ map fst
            $ iterate (\(x, y) -> (y, x + y)) (x, y)
          | x <- Map.keys cnts
          , y <- Map.keys cnts
          ]

import           Control.Monad
import           Data.List
import           Control.Arrow
import           Data.Array
import qualified Data.Map.Strict               as Map
import           Data.Either

($$) = flip ($)

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

readInt :: IO Int
readInt = read <$> getLine

main :: IO ()
main = do
    _  <- readInt
    as <- readInts
    let cnts = sort as $$ group $$ map (head &&& length) $$ Map.fromList
    -- print cnts
    print $ maxFib cnts

-- maxFib :: Map.HashMap Int Int -> [Either Int (Map.HashMap Int Int)]
maxFib cnts =
    (\xs -> if null xs then 1 else maximum xs)
        $ lefts
        $ [ foldM
                (\(mp, l) v ->
                    if Map.member v cnts && Map.findWithDefault 0 v mp < cnts Map.! v
                        then Right (Map.insertWith (+) v 1 mp, l + 1)
                        else Left l
                )
                (Map.empty, 0)
            $ map fst
            $ iterate (\(x, y) -> (y, x + y)) (x, y)
          | x <- Map.keys cnts
          , y <- Map.keys cnts
          , x <= y
          ]

import           Control.Monad
import           Data.List
import           Control.Arrow
import           Data.Array
import qualified Data.Map.Strict               as Map
import           Data.Either
import           Data.Int

($$) = flip ($)

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

readInt :: IO Int64
readInt = read <$> getLine

main :: IO ()
main = do
    _  <- readInt
    as <- readInts
    let cnts = sort as $$ group $$ map (head &&& length) $$ Map.fromList
    -- print cnts
    print $ maxFib cnts

-- maxFib :: Map.HashMap Int Int -> [Either Int (Map.HashMap Int Int)]
maxFib cnts =
    (\xs -> if null xs then 1 else maximum xs)
        $ lefts
        $ [ foldM
                (\(mp, l) v ->
                    if Map.member v cnts && Map.findWithDefault 0 v mp < cnts Map.! v
                        then Right (Map.insertWith (+) v 1 mp, l + 1)
                        else Left l
                )
                (Map.empty, 0)
            $ map fst
            $ iterate (\(x, y) -> (y, x + y)) (x, y)
          | x <- Map.keys cnts
          , y <- Map.keys cnts
          , x <= y
          ]

import           Control.Monad
import           Data.List
import           Control.Arrow
import           Data.Array
import qualified Data.Map.Strict               as Map
import           Data.Either

($$) = flip ($)

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

readInt :: IO Int
readInt = read <$> getLine

main :: IO ()
main = do
    _  <- readInt
    as <- readInts
    let cnts = sort as $$ group $$ map (head &&& length) $$ Map.fromList
    -- print cnts
    print $ maxFib cnts

-- maxFib :: Map.HashMap Int Int -> [Either Int (Map.HashMap Int Int)]
maxFib cnts = maximum $ lefts
    [ foldM
          (\(mp, l) v -> if Map.member v cnts && Map.findWithDefault 0 v mp < cnts Map.! v
              then Right (Map.insertWith (+) v 1 mp, l + 1)
              else Left l
          )
          (Map.empty, 0)
      $ map fst
      $ iterate (\(x, y) -> (y, x + y)) (x, y)
    | x <- Map.keys cnts
    , y <- Map.keys cnts
    , x < y
    ]


A median of an array of integers of length $$$n$$$ is the number standing on the $$$\lceil {\frac{n}{2}} \rceil$$$ (rounding up) position in the non-decreasing ordering of its elements. Positions are numbered starting with $$$1$$$. For example, a median of the array $$$[2, 6, 4, 1, 3, 5]$$$ is equal to $$$3$$$. There exist some other definitions of the median, but in this problem, we will use the described one.Given two integers $$$n$$$ and $$$k$$$ and non-decreasing array of $$$nk$$$ integers. Divide all numbers into $$$k$$$ arrays of size $$$n$$$, such that each number belongs to exactly one array.You want the sum of medians of all $$$k$$$ arrays to be the maximum possible. Find this maximum possible sum.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The next $$$2t$$$ lines contain descriptions of test cases. The first line of the description of each test case contains two integers $$$n$$$, $$$k$$$ ($$$1 \leq n, k \leq 1000$$$). The second line of the description of each test case contains $$$nk$$$ integers $$$a_1, a_2, \ldots, a_{nk}$$$ ($$$0 \leq a_i \leq 10^9$$$) — given array. It is guaranteed that the array is non-decreasing: $$$a_1 \leq a_2 \leq \ldots \leq a_{nk}$$$. It is guaranteed that the sum of $$$nk$$$ for all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print a single integer — the maximum possible sum of medians of all $$$k$$$ arrays.

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

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Integer]
process [] = []
process ([n, k]:xs:xss) = solve n k xs : process xss

solve :: Int -> Int -> [Int] -> Integer
solve n k xs =
  sum . map fromIntegral . take k . map fst . filter ((== 0) . (`mod` nn) . snd) $
  zip (reverse $ sort xs) [1 ..]
  where
    nn = 1 + (n `div` 2)

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

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process ([n, k]:xs:xss) = solve n k xs : process xss

solve :: Int -> Int -> [Int] -> Int
solve n k xs =
  sum . take k . map fst . filter ((== 0) . (`mod` nn) . snd) $
  zip (reverse $ sort xs) [1 ..]
  where
    nn = 1 + (n `div` 2)


Today, Wet Shark is given n integers. Using any of these integers no more than once, Wet Shark wants to get maximum possible even (divisible by 2) sum. Please, calculate this value for Wet Shark. Note, that if Wet Shark uses no integers from the n integers, the sum is an even integer 0.

The first line of the input contains one integer, n (1 ≤ n ≤ 100 000). The next line contains n space separated integers given to Wet Shark. Each of these integers is in range from 1 to 109, inclusive.

Print the maximum possible even sum that can be obtained if we use some of the given integers.

NoteIn the first sample, we can simply take all three integers for a total sum of 6.In the second sample Wet Shark should take any four out of five integers 999 999 999.

import Control.Monad
import Control.Arrow
import Data.List

getMin :: [Integer] -> Integer
getMin [] = 0
getMin xs = ((minimum &&& (length >>> fromIntegral >>> (`mod` 2))) >>> uncurry (*)) xs

main :: IO ()
main = do
    _ <- getLine
    xs <- liftM (map(read::String->Integer) . words) getLine
    print $ (((sum::[Integer] -> Integer)  *** ((sum &&& getMin) >>> uncurry (-))) >>> uncurry (+)) $ partition even xs

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

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

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  let
    (a, b) = partition even xs

  print $ sum a + sum (if even $ length b then b else (tail $ sort b))

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  getLine
  inp <- fmap (map read . words) getLine
  print $ solve inp

solve :: [Integer] -> Integer
solve = g . dropWhile (<=0) . sort
    where
      g [] = 0
      g x | even (sum x) = sum x
          | otherwise = sum prefix + sum suffix
          where
            (prefix, _:suffix) = break odd x

inp :: [Integer]
inp = [999999999, 999999999, 999999999, 999999999, 999999999]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
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 >>=  \n-> (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve xs = let fs= filter (\a->a `mod`2/=0) xs; m = if fs/=[] then minimum fs else 0 ; s=sum xs in if s `mod`2==0  then print s else print (s-m)

module Main where

import Data.List
import Data.String
import Data.Maybe
import Data.Either
import Data.Ord
import Control.Monad
import Control.Applicative
import Control.Arrow

main :: IO()
main = do
    _ <- liftM (read::String->Integer) getLine
    xs <- liftM (map(read::String->Integer) . words) getLine
    print $ foldl (+) 0 (filter even xs) + foldl (+) 0 (let ys = sort $ filter odd xs in if even (length ys) then ys else tail ys)

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

process a | even s = s
          | otherwise = s-m
  where s = sum a
        m = minimum $ filter odd a

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

import qualified Data.ByteString.Char8 as B
import Data.List
main = do
    B.getLine
    ns <- fmap (map readInteger . B.words) B.getLine
    let s = sum ns
    print $ if even s then s else s - minimum (filter odd ns)
readInteger s = i where Just (i,_) = B.readInteger s

import Data.List.Split

solve n
    | (length o) `rem` 2 == 0 = sum o + sum e
    | otherwise = sum e + sum o - minimum o
    where
        o = filter odd n
        e = filter even n

main = do
    name <- getLine
    s <- getLine
    let foo = solve (map (read) (splitOn " " s))
    putStrLn $ show foo

import Control.Monad
import Data.List

main = do
  getLine
  s <- getLine
  let ss = words s
      ns = sort $ map (\x -> read x :: Integer) ss
      summ = sum ns
  if even summ
    then putStrLn $ show summ
    else putStrLn $ show (summ - firstOdd ns)

firstOdd :: [Integer] -> Integer
firstOdd (x:xs)
  | odd x     = x
  | otherwise = firstOdd xs

solve a
	| even s    = s
	| otherwise = s - minimum [x | x <- a, odd x]
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve (map read (words l))

solve a
	| even s    = s
	| otherwise = s - minimum (filter odd a)
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve(map read (words l))

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

myprint x1 = putStrLn $ intercalate " " $ map show x1

main= do
	n<-  read <$> getLine  ::IO Int
	s<- map (fst.fromJust.C.readInteger) . C.words <$> C.getLine ::IO [Integer]
	let ss = sum s
	let m = filter odd s
	if even (length m ) then print ss else print $ ss - minimum m

getLoL :: (Read a) => IO [[a]]
getLoL = fmap (fmap (fmap read . words) . lines) getContents

main :: IO ()
main = do
        [_, xs]  <- getLoL
        print $ solve xs

solve :: [Integer] -> Integer
solve xs = if even s then s else s - leastOdd
    where s = sum xs
          leastOdd = minimum [x | x <- xs, odd x]

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - (minimum os)
         | otherwise      = 0
         where
            s = sum xs
            os = filter odd xs
            m = length os

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Integer]
    print $ solve xs

import Control.Monad
import Control.Arrow
import Data.List

main :: IO ()
main = do
    _ <- getLine
    xs <- liftM (map(read::String->Int) . words) getLine
    print $ ((sum *** (sum &&& ((minimum &&& (length >>> (`mod` 2))) >>> uncurry (*)) >>> uncurry (-))) >>> uncurry (+)) $ partition even xs

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  getLine
  inp <- fmap (map read . words) getLine
  print $ solve inp

solve :: [Int] -> Int
solve = g . takeWhile (>=0) . sort
    where
      g [] = 0
      g x | even (sum x) = sum x
          | otherwise = sum prefix + sum suffix
          where
            (prefix, _:suffix) = break odd x

inp :: [Int]
inp = [999999999, 999999999, 999999999, 999999999, 999999999]

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

process a | even s = s
          | otherwise = s-m
  where s = sum a
        m = minimum $ filter odd a

main=do
  getLine
  a<- map read <$> words <$> getLine ::IO [Int]
  print $ process a

import Control.Monad
import Data.List

main = do
  getLine
  s <- getLine
  let ss = words s
      ns = sort $ map (\x -> read x :: Int) ss
      summ = sum ns
  if even summ
    then putStrLn $ show summ
    else putStrLn $ show (summ - firstOdd ns)

firstOdd :: [Int] -> Int
firstOdd (x:xs)
  | odd x     = x
  | otherwise = firstOdd xs

solve a
	| even s    = s
	| otherwise = s - minimum a
	where s = sum a

main = do
	_ <- getLine
	l <- getLine
	print $ solve (map read (words l))

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - (minimum os)
         | otherwise      = 0
         where
            s = sum xs
            os = filter odd xs
            m = length os

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Int]
    print $ solve xs

import Data.List

solve xs | s `mod` 2 == 0 = s
         | m > 0          = s - head os
         | otherwise      = 0
         where
            os = sort $ filter odd xs
            m = length os
            s = sum xs

main :: IO ()
main = do
    input <- getContents
    let xs = map read $ words $ last $ lines input :: [Int]
    print $ solve xs


Given the integer $$$n$$$ — the number of available blocks. You must use all blocks to build a pedestal. The pedestal consists of $$$3$$$ platforms for $$$2$$$-nd, $$$1$$$-st and $$$3$$$-rd places respectively. The platform for the $$$1$$$-st place must be strictly higher than for the $$$2$$$-nd place, and the platform for the $$$2$$$-nd place must be strictly higher than for the $$$3$$$-rd place. Also, the height of each platform must be greater than zero (that is, each platform must contain at least one block).    Example pedestal of $$$n=11$$$ blocks: second place height equals $$$4$$$ blocks, first place height equals $$$5$$$ blocks, third place height equals $$$2$$$ blocks.Among all possible pedestals of $$$n$$$ blocks, deduce one such that the platform height for the $$$1$$$-st place minimum as possible. If there are several of them, output any of them.

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case contains a single integer $$$n$$$ ($$$6 \le n \le 10^5$$$) — the total number of blocks for the pedestal. All $$$n$$$ blocks must be used. It is guaranteed that the sum of $$$n$$$ values over all test cases does not exceed $$$10^6$$$.

For each test case, output $$$3$$$ numbers $$$h_2, h_1, h_3$$$ — the platform heights for $$$2$$$-nd, $$$1$$$-st and $$$3$$$-rd places on a pedestal consisting of $$$n$$$ blocks ($$$h_1+h_2+h_3=n$$$, $$$0 < h_3 < h_2 < h_1$$$).  Among all possible pedestals, output the one for which the value of $$$h_1$$$ minimal. If there are several of them, output any of them.

NoteIn the first test case we can not get the height of the platform for the first place less than $$$5$$$, because if the height of the platform for the first place is not more than $$$4$$$, then we can use at most $$$4 + 3 + 2 = 9$$$ blocks. And we should use $$$11 = 4 + 5 + 2$$$ blocks. Therefore, the answer 4 5 2 fits. In the second set, the only suitable answer is: 2 3 1.

module Main where

import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep = id

parse = read

format = id

solve n = unwords $ map (show . (+b)) p
  where (b,x) = (n-3) `divMod` 3
        p = case x of
              0 -> [1,2,0]
              1 -> [1,3,0]
              2 -> [2,3,0]

{-# LANGUAGE LambdaCase #-}

module Main where

import Control.Monad.State
import qualified Data.ByteString.Char8 as C
import Data.Maybe

--

solve :: Int -> (Int, Int, Int)
solve n = case n `divMod` 3 of
  (k, 0) -> (k, k + 1, k - 1)
  (k, 1) -> (k, k + 2, k - 1)
  (k, 2) -> (k + 1, k + 2, k - 1)
  _ -> error "fuck"

input = int

output (a, b, c) = C.unwords . map (C.pack . show) $ [a, b, c]

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

-- 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 sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

testcase :: Int->[Int]
testcase x  | mod x 3 == 0 = [(a+1), (a+2), a]
            | mod x 3 == 1 = [(b+1), (b+3), b]
            | mod x 3 == 2 = [(c+2), (c+3), c]
                where   a = div (x-3) 3
                        b = div (x-4) 3
                        c = div (x-5) 3

solve :: Int -> IO()
solve 0 = putStr ""
solve k = do
    line <- getLine
    let {   n = read ((words line) !! 0);
            a = testcase n;
            solution = unwords . map show $ a}
    putStrLn solution
    --putStrLn ("TEST: "++ show k)
    solve (k-1)

main::IO()
main = do
    line <- getLine
    let {a = read ((words  line) !! 0)}
    solve a

--Problem A, CF #797 (Div. 3)

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> (Int, Int, Int)
solve s = (h2, h3, h1)
    where
        h1 = (s - 3) `div` 3
        h2 = (s - h1 - 1) `div` 2
        h3 = s - h1 - h2

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> readIntB8
        let (h1, h2, h3) = solve s
        printf "%d %d %d\n" h1 h2 h3

-- boilerplate {{{1
-- vim: foldmethod=marker
-- pragmas {{{2
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module Main where -- {{{2

import Control.Applicative
import Control.Arrow ( (|||), (&&&) )
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Foldable hiding ( sum, product )
import Data.Function
import Data.Functor
import Data.IntMap ( IntMap )
import Data.IntSet ( IntSet )
import Data.List hiding ( sum, product )
import Data.Map ( Map )
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup ( Min(..), Max(..) )
import Data.Sequence ( Seq )
import Data.Set ( Set )
import Data.Text ( Text )
import Data.Traversable
import Data.Tuple
import Debug.Trace
import Prelude hiding ( sum, product )
import System.IO
-- import System.Random
import Text.Printf
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap           as IM
import qualified Data.IntSet           as IS
import qualified Data.Map              as LM
import qualified Data.Map.Strict       as M
import qualified Data.Sequence         as Q
import qualified Data.Set              as S
import qualified Data.Text             as T
import qualified Data.Text.IO          as T

-- utilites {{{2
readInt s = let Just (i,_) = C.readInt s in i :: Int
getInt = readInt <$> C.getLine
getInts = map readInt . C.words <$> C.getLine
putShows :: Show a => [a] -> IO ()
putShows = putStrLn . unwords . map show
ynq = putStrLn . bool "NO" "YES"
gcount g@(x:_) = (x, length g)
modulus = 10^9 + 7 :: Int
mod' x = rem x modulus
tri n = quot (n * n + n) 2
sum t     = foldl' (+) 0 t
product t = foldl' (*) 1 t
mprint :: Show a => String -> Maybe a -> IO ()
mprint s = maybe (putStrLn s) print
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t e = b >>= bool e t
whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())

-- }}}1

main = getInt >>= flip replicateM_ docase

docase = do
    [n] <- getInts
    let (q,r) = quotRem n 3
    putShows $ case r of
        0 -> [q,q+1,q-1]
        1 -> [q,q+2,q-1]
        2 -> [q+1,q+2,q-1]


You are given string s consists of opening and closing brackets of four kinds <>, {}, [], (). There are two types of brackets: opening and closing. You can replace any bracket by another of the same type. For example, you can replace < by the bracket {, but you can't replace it by ) or >.The following definition of a regular bracket sequence is well-known, so you can be familiar with it.Let's define a regular bracket sequence (RBS). Empty string is RBS. Let s1 and s2 be a RBS then the strings <s1>s2, {s1}s2, [s1]s2, (s1)s2 are also RBS.For example the string "[[(){}]<>]" is RBS, but the strings "[)()" and "][()()" are not.Determine the least number of replaces to make the string s RBS.

The only line contains a non empty string s, consisting of only opening and closing brackets of four kinds. The length of s does not exceed 106.

If it's impossible to get RBS from s print Impossible. Otherwise print the least number of replaces needed to get RBS from s.

fldl :: (Maybe (a, Int) -> b -> Maybe (a, Int)) -> Maybe (a, Int) -> [b] -> Maybe (a, Int)
fldl f st [] = st
fldl f st (x:xs) = fldl f (f st x) xs

solve :: Maybe (String, Int) -> Char -> Maybe (String, Int)
solve Nothing _ = Nothing
solve (Just x) '{' = Just (('{': fst x), snd x)
solve (Just x) '[' = Just (('[': fst x), snd x)
solve (Just x) '(' = Just (('(': fst x), snd x)
solve (Just x) '<' = Just (('<': fst x), snd x)
solve (Just ((x:xs), n)) '}' = if x == '{' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) ']' = if x == '[' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) ')' = if x == '(' then Just (xs, n) else Just (xs, n + 1)
solve (Just ((x:xs), n)) '>' = if x == '<' then Just (xs, n) else Just (xs, n + 1)
solve _ _ = Nothing

predicat :: Maybe (String, Int) -> String
predicat (Just ([], x)) = show x
predicat (Just (_, _)) = "Impossible"
predicat Nothing = "Impossible"

main :: IO()
main = getLine >>= \s -> putStrLn $ predicat $ fldl solve (Just ([], 0)) s

import Data.List

main = do
  s <- getLine

  let
    count [] [] = Just 0
    count [] _ = Nothing
    count (c:s) stack
      | c `elem` os = count s (c:stack)
      | null stack = Nothing
      | top `notElem` os = Nothing
      | otherwise = (+ a) `fmap` (count s (tail stack))
      where
        os = "[<{("
        cs = "]>})"
        a = if c `elemIndex` cs == top `elemIndex` os then 0 else 1
        top = head stack

    r = count s []

  case r of
    Nothing -> putStrLn "Impossible"
    Just c -> putStrLn $ show c

import Control.Applicative
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    s <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""

import Data.Maybe
import Control.Applicative

close c
    | c == '[' = ']'
    | c == '(' = ')'
    | c == '<' = '>'
    | c == '{' = '}'

isOpen x = x == '{' || x == '[' || x == '<' || x == '('

fold :: [Char] -> [Char] -> Maybe Int
fold [] [] = Just 0
fold (x:xs) []
    | isOpen(x) = fold xs [x]
    | otherwise = Nothing

fold [] (p:ps) = Nothing

fold (x:xs) (p:ps)
    | x == '{' || x == '[' || x == '<' || x == '(' = fold xs (x:p:ps)
    | x == close p = fold xs ps
    | otherwise = pure (+) <*> Just 1 <*> fold xs ps

answer :: Maybe Int -> String
answer Nothing = "Impossible"
answer (Just i) = show(i)

main = getLine >>= (\s -> putStrLn $ answer $ fold s [])

close c
    | c == '[' = ']'
    | c == '(' = ')'
    | c == '<' = '>'
    | c == '{' = '}'

isOpen x = x == '{' || x == '[' || x == '<' || x == '('

fold :: [Char] -> [Char] -> Int
fold [] [] = 0
fold (x:xs) []
    | isOpen(x) = fold xs [x]
    | otherwise = -100000

fold [] (p:ps) =
    -10000000

fold (x:xs) (p:ps)
    | x == '{' || x == '[' || x == '<' || x == '(' = fold xs (x:p:ps)
    | x == close p = fold xs ps
    | otherwise = 1 + fold xs ps

answer i
    | i >= 0 = show i
    | otherwise = "Impossible"

main = getLine >>= (\s -> putStrLn $ answer (fold s []))

import Data.Maybe
import Data.Bool
import Control.Monad

convL2R :: Char -> Char
convL2R '[' = ']'
convL2R '{' = '}'
convL2R '(' = ')'
convL2R '<' = '>'
convL2R _ = undefined

isrbr :: Char -> Bool
isrbr ']' = True
isrbr '}' = True
isrbr ')' = True
isrbr '>' = True
isrbr _ = False

solve' :: String -> [Char] -> Maybe Int
solve' (x:xs) y
 | and [isrbr x, y == []] = Nothing
 | isrbr x = liftM2 (+) (if x == head y then Just 0 else Just 1) (solve' xs (tail y) )
 | otherwise = solve' xs ([convL2R x] ++ y)

solve' _ [] = Just 0
solve' _ _ = Nothing

solve :: String -> Maybe Int
solve x = solve' x []

pImpossible :: Maybe Int -> String

pImpossible Nothing = "Impossible\n"
pImpossible a = show $ fromJust a

parse :: String -> String

parse = pImpossible . solve . unwords. words

main = interact parse

import Control.Monad

main = interact $ (\[s] -> case foldM f ("", 0) s of
                            Just ([], a) -> show a
                            _ -> "Impossible"
                  ) . words

f (s, a) c
    | elem c "<([{" = Just (c:s, a)
    | otherwise = case s of
                    [] -> Nothing
                    (x:r) -> Just (r, a + if x == l c then 0 else 1)

l '>' = '<'
l ')' = '('
l ']' = '['
l '}' = '{'

import Control.Monad

main = interact $ (\[s] -> case foldM f ("", 0) s of
                            Just ([], a) -> show a
                            _ -> "Impossible"
                  ) . words

f (s, a) c
    | elem c ['<', '(', '[', '{'] = Just (c:s, a)
    | otherwise = case s of
                    [] -> Nothing
                    (x:r) -> Just (r, a + if x == l c then 0 else 1)

l '>' = '<'
l ')' = '('
l ']' = '['
l '}' = '{'

fldl :: ((a, Int) -> b -> (a, Int)) -> (a, Int) -> [b] -> (a, Int)
fldl f st [] = st
fldl f st (x:xs) = fldl f (f st x) xs

solve :: (String, Int) -> Char -> (String, Int)
solve x '{' = (('{': fst x), snd x)
solve x '[' = (('[': fst x), snd x)
solve x '(' = (('(': fst x), snd x)
solve x '<' = (('<': fst x), snd x)
solve ([], n) _ = (['>'], 0)
solve ((x:xs), n) '}' = if x == '{' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) ']' = if x == '[' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) ')' = if x == '(' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) '>' = if x == '<' then (xs, n) else (xs, n + 1)
solve ((x:xs), n) _ = (['>'], 0)

predicat :: (String, Int) -> String
predicat ([], x) = show x
predicat (_, _) = "Impossible"

main :: IO()
main = getLine >>= \s -> putStrLn $ predicat $ fldl solve ([], 0) s

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

main = do
    s <- BS.unpack <$> BS.getLine
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    ')' -> '('
    ']' -> '['
    '}' -> '{'
    '>' -> '<'

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

main = do
    s <- BS.unpack <$> BS.getLine
    BS.getContents
    putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    ')' -> '('
    ']' -> '['
    '}' -> '{'
    '>' -> '<'

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

main = do
    s <- BS.unpack <$> BS.getLine
    putStrLn s
    --putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""

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

main = do
    s <- BS.unpack <$> BS.getLine
    print $ length s
    --putStrLn . fromMaybe "Impossible" . fmap show $ solve s []

solve [] [] = Just 0
solve [] _  = Nothing
solve (c : s) toClose
    | elem c "([{<" = solve s $ matching c : toClose
    | otherwise     = case toClose of
        []      -> Nothing
        x : xs  -> let sol = solve s xs in if x == c then sol else (+ 1) <$> sol

matching c = case c of
    '(' -> ')'
    '[' -> ']'
    '{' -> '}'
    '<' -> '>'
    _   -> error ""


A k-multiple free set is a set of integers where there is no pair of integers where one is equal to another integer multiplied by k. That is, there are no two integers x and y (x < y) from the set, such that y = x·k.You're given a set of n distinct positive integers. Your task is to find the size of it's largest k-multiple free subset.

The first line of the input contains two integers n and k (1 ≤ n ≤ 105, 1 ≤ k ≤ 109). The next line contains a list of n distinct positive integers a1, a2, ..., an (1 ≤ ai ≤ 109). All the numbers in the lines are separated by single spaces.

On the only line of the output print the size of the largest k-multiple free subset of {a1, a2, ..., an}.

NoteIn the sample input one of the possible maximum 2-multiple free subsets is {4, 5, 6}.

import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Data.List(sort)

main = putStrLn . show . solve . map (toInteger . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Integer] -> Int
solve (_ : 1 : as) = length as
solve (_ : k : as) = sum [(length x + 1) `div` 2 | (_, xs) <- M.toList $ M.fromListWith (++) [(root a, [a]) | a <- as], x <- split $ sort xs]
  where
  split (x : xs) = split' [[x]] xs
  split' ((a : xs) : xss) (b : ys)
    | a * k == b = split' ((b : a : xs) : xss) ys
    | otherwise  = split' ([b] : (a : xs) : xss) ys
  split' xss _ = xss
  root a
    | mod a k > 0 = a
    | otherwise   = root (div a k)

{-# LANGUAGE BangPatterns #-}

import qualified Data.IntSet as S
import Data.List

main = do
  [_, k] <- (map read . words) `fmap` getLine
  as     <- (map read . words) `fmap` getLine
  print (solve k as)

solve :: Int -> [Int] -> Int
solve k s = go S.empty (reverse $ sort s)
  where
    mx = maxBound `div` k
    go !s (x:xp) | x > mx || (x*k) `S.notMember` s = go (S.insert x s) xp
                 | otherwise                       = go s xp
    go  s   []   = S.size s

import Control.Monad (liftM)
import Data.Char (ord)
import Data.Function (on)
import Data.List (intercalate, groupBy, sort, sortBy)

solve :: Integer -> [Integer] -> Int
solve k as  =  sum $ map (cut . sort . map fst) $ groupSnd $ sortSnd $ zip as $ map kClass as
  where
    sortSnd  =  sortBy (compare `on` snd)
    groupSnd  =  groupBy ((==) `on` snd)
    kClass x
      | x `mod` k == 0  =  kClass (x `div` k)
      | otherwise  =  x
    cut (a:b:xs)
      | a * k == b  =  1 + cut xs
      | otherwise  =  1 + cut (b:xs)
    cut xs  =  length xs

main :: IO ()
main  =  do
    [n, k]  <-  reads
    if k == 1 then
        print n
    else do
        as  <-  reads
        print $ solve k as

  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import Control.Applicative ((<$>), (<*>))
import Data.List (foldl', sort)
import qualified Data.Set as S

main :: IO ()
main = print =<< solve <$> (read <$> (!!1) <$> words <$> getLine) <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> Int
solve k = S.size . foldl' (\s x -> if S.member x s then s else S.insert (k * x) s) S.empty . sort

import Data.List as List
import qualified Data.Set as Set

readInts :: String -> [Integer]
readInts str = map read (words str)

g :: Integer -> Set.Set Integer -> Integer -> Set.Set Integer
g k set x
 |Set.member (k*x) set = set
 |otherwise = Set.insert x set

main :: IO ()
main = do
  [_, k] <- fmap readInts getLine
  xs' <- fmap readInts getLine
  let xs = reverse $ List.sort xs'
  print $ Set.size $ foldl' (g k) Set.empty xs

import Data.List as List
import qualified Data.Set as Set

readInts :: String -> [Double]
readInts str = map read (words str)

g :: Double -> Set.Set Double -> Double -> Set.Set Double
g k set x
 |Set.member (k*x) set = set
 |otherwise = Set.insert x set

main :: IO ()
main = do
  [_, k] <- fmap readInts getLine
  xs' <- fmap readInts getLine
  let xs = reverse $ List.sort xs'
  print $ Set.size $ foldl' (g k) Set.empty xs

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

readInteger bs = case B.readInteger bs of Just (n,_) -> n

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

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ sort xs
   where
     go !res !set (x:xs)
       | x `S.member` set = go res set xs
       | otherwise = go (res+1) (S.insert (k*x) set) xs
     go res _ _ = res

import Control.Applicative ((<$>), (<*>))
import Data.List (foldl')
import qualified Data.Set as S

main :: IO ()
main = print =<< solve <$> (read <$> (!!1) <$> words <$> getLine) <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> Int
solve k = S.size . foldl' (\s x -> if S.member x s then s else S.insert (k * x) s) S.empty

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

readInteger bs = case B.readInteger bs of Just (n,_) -> n

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

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ sort xs
   where
     go !res !set (x:xs)
       | x `S.member` set = go res (S.insert (k*x) set) xs
       | otherwise = go (res+1) (S.insert (k*x) set) xs
     go res _ _ = res

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Set as S

readInteger bs = case B.readInteger bs of Just (n,_) -> n

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

solve :: Integer -> [Integer] -> Int
solve k xs = go 0 S.empty $ map (\ys->(length ys,ys!!0)) $ group $ sort xs
   where
     go !res !set ((l,x):xs)
       | x `S.member` set = go res (S.insert (k*x) set) xs
       | otherwise = go (res+l) (S.insert (k*x) set) xs
     go res _ _ = res


You have a string $$$s$$$ consisting of digits from $$$0$$$ to $$$9$$$ inclusive. You can perform the following operation any (possibly zero) number of times:   You can choose a position $$$i$$$ and delete a digit $$$d$$$ on the $$$i$$$-th position. Then insert the digit $$$\min{(d + 1, 9)}$$$ on any position (at the beginning, at the end or in between any two adjacent digits). What is the lexicographically smallest string you can get by performing these operations?A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ of the same length if and only if the following holds:   in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a smaller digit than the corresponding digit in $$$b$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then the test cases follow. Each test case consists of a single line that contains one string $$$s$$$ ($$$1 \le |s| \le 2 \cdot 10^5$$$) — the string consisting of digits. Please note that $$$s$$$ is just a string consisting of digits, so leading zeros are allowed. It is guaranteed that the sum of lengths of $$$s$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

Print a single string — the minimum string that is possible to obtain.

NoteIn the first test case:   Delete $$$8$$$ and insert $$$9$$$ at the end of the notation. The resulting notation is $$$04299$$$.  Delete $$$4$$$ and insert $$$5$$$ in the $$$3$$$-rd position of the notation. The resulting notation is $$$02599$$$. Nothing needs to be done in the second and third test cases.

import Data.Bifunctor (second)
import Data.Char (chr, ord)
import Data.List (sort)

(>$>) = flip ($)
(>>>) = flip (.)
infixl 0 >$>

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

solve :: String -> String
solve = pick 0 >>> second (sort >>> map (ord >>> (1 +) >>> min (ord '9') >>> chr)) >>> uncurry merge

merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge (x : xs) (y : ys)
  | x <= y = x : merge xs (y : ys)
  | otherwise = y : merge (x : xs) ys

pick :: Int -> String -> (String, String)
pick 10 s = ("", s)
pick d s = (filter (== c) lt ++ lt', filter (/= c) lt ++ rt')
  where
    c = head $ show d
    lt = s >$> reverse >>> dropWhile (/= c)
    (lt', rt') = s >$> reverse >>> takeWhile (/= c) >>> reverse >>> pick (d + 1)

import Data.Char (chr, ord)
import Data.List (sort)
import Debug.Trace (trace)

(>$>) = flip ($)

(>>>) = flip (.)

infixl 0 >$>

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

solve :: String -> String
solve s = merge lt rt'
  where
    (lt, rt) = pick 0 s
    rt' = rt >$> sort >>> map (ord >>> (1 +) >>> min (ord '9') >>> chr)

merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
  | x <= y = x : merge xs (y:ys)
  | otherwise = y : merge (x:xs) ys

pick :: Int -> String -> (String, String)
pick 10 s = ("", s)
pick d s = (filter (== c) lt ++ lt', filter (/= c) lt ++ rt')
  where
    c = head $ show d
    lt = s >$> reverse >>> dropWhile (/= c)
    (lt', rt') = s >$> reverse >>> takeWhile (/= c) >>> reverse >>> pick (d + 1)

debug :: Show a => a -> a
debug a = trace (show a) a

import Data.Char (chr, ord)
import Data.List (sort, partition)
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>= putStrLn . minStr

inc :: Char -> Char
inc c | c < '9' = chr (1+ord c)
      | c == '9'= '9'

minStr :: String -> String
minStr s = let (ms, rest) = minSubSeq s
           in
             sort (ms ++ map inc rest)

-- WRONG ANSWER for case: 32454 - expected 24445 - got 24556
-- find the lexicographically smallest subsequence in a given string
minSubSeq :: String -> (String, String)
minSubSeq s = let mlss [] (stack, trash) = (reverse stack, trash)
                  mlss s (stack, trash) = let (i, c, count) = minCharCount s in
                                            mlss (drop i s) (replicate count c ++ stack, filter (/=c) (take i s) ++ trash)
              in
                mlss s ([], [])

minCharCount s = foldl f (1, head s, 1) (zip [2..] (tail s))
  where
    f (i, c, count) (ii, cc) = case compare c cc of
                                 EQ -> (ii, c, count+1)
                                 GT -> (ii, cc, 1)
                                 LT -> (i, c, count)

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

toInt c = ord c - ord '0'

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        IO.getLine
    mapM_ (putStrLn.showDigs.solve) tcs

showDigs = concatMap show

solve digs = ans
  where
    ans = L.sort . snd . foldl prevD (9+1,[]) . reverse . map toInt $ digs

prevD (minDig, digs) dig = (min minDig dig, fixedDig : digs)
  where
    fixedDig | (dig == 9)      = dig
             | (dig > minDig)  = dig + 1
             | otherwise       = dig

import Data.Char (chr, ord)
import Data.List (sort, partition)
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>= putStrLn . minStr

minStr :: String -> String
minStr s = let (ms, rest) = minSubSeq s
               inc c | c < '9' = chr (1+ord c)
                     | c == '9'= '9'
           in
             ms ++ map inc (sort rest)

-- find the lexicographically smallest subsequence in a given string
minSubSeq :: String -> (String, String)
minSubSeq s = let mlss [] (stack, []) = (reverse stack, [])
                  mlss [] (stack, trash) = let mt = minimum trash
                                               (s1, t1) = partition (<mt) stack
                                           in
                                             (reverse s1, t1++trash)
                  mlss s (stack, trash) = let (i, c, count) = minCharCount s in
                                            mlss (drop i s) (replicate count c ++ stack, filter (/=c) (take i s) ++ trash)
              in
                mlss s ([], [])

minCharCount s = foldl f (1, head s, 1) (zip [2..] (tail s))
  where
    f (i, c, count) (ii, cc) = case compare c cc of
                                 EQ -> (ii, c, count+1)
                                 GT -> (ii, cc, 1)
                                 LT -> (i, c, count)


The student council has a shared document file. Every day, some members of the student council write the sequence TMT (short for Towa Maji Tenshi) in it.However, one day, the members somehow entered the sequence into the document at the same time, creating a jumbled mess. Therefore, it is Suguru Doujima's task to figure out whether the document has malfunctioned. Specifically, he is given a string of length $$$n$$$ whose characters are all either T or M, and he wants to figure out if it is possible to partition it into some number of disjoint subsequences, all of which are equal to TMT. That is, each character of the string should belong to exactly one of the subsequences.A string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero) characters.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 5000$$$)  — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$3 \le n < 10^5$$$), the number of characters in the string entered in the document. It is guaranteed that $$$n$$$ is divisible by $$$3$$$. The second line of each test case contains a string of length $$$n$$$ consisting of only the characters T and M. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print a single line containing YES if the described partition exists, and a single line containing NO otherwise.

5
3
TMT
3
MTT
6
TMTMTT
6
TMTTTT
6
TTMMTT

NoteIn the first test case, the string itself is already a sequence equal to TMT.In the third test case, we may partition the string into the subsequences TMTMTT. Both the bolded and the non-bolded subsequences are equal to TMT.

import Control.Monad
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    s <- C.filter (not . isSpace) <$> C.getLine
    let acc Nothing _ = Nothing
        acc (Just x) 'T' = Just (x + 1)
        acc (Just x) _
          | x == 0 = Nothing
          | otherwise = Just (x - 1)
        check = maybe False (== n `div` 3) . C.foldl' acc (Just 0)
    C.putStrLn $ C.pack $ if check s && check (C.reverse s) then "YES" else "NO"

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

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

type State = Maybe (Int, Seq.Seq Char)
acc :: State -> Char -> State
acc Nothing _ = Nothing
acc (Just (ls, rs)) 'M'
  | Seq.null bs = Nothing
  | otherwise = Just (ls + Seq.length as, Seq.drop 1 bs Seq.|> 'M')
  where (as, bs) = Seq.spanl (== 'M') rs
acc (Just (ls, rs)) 'T' = Just (ls, rs Seq.|> 'T')
acc o _ = o

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    s <- C.getLine
    let
        result = maybe False func $ C.foldl' acc (Just (0, Seq.empty)) s
        func (ms, str) =
          case foldl' acc (Just ms) str of
            Nothing -> False
            Just 0 -> True
            _ -> False
          where acc Nothing _ = Nothing
                acc (Just ms) 'T' = if ms <= 0 then Nothing else Just (ms - 1)
                acc (Just ms) 'M' = Just (ms + 1)
                acc o _ = o
    C.putStrLn $ C.pack $ if result then "YES" else "NO"

{-# LANGUAGE ViewPatterns #-}
import Control.Monad ( replicateM_ )
import Data.Bool ( bool )

solve :: Int -> String -> Bool
solve ((`div` 3) -> k) str = valid && t == k
    where
    (t, valid) = foldr loop (0, True) str

    loop x (upd x -> t, valid) = (t, valid && 0<=t && t<=k)

    upd 'T' = succ
    upd 'M' = pred

getInt = read <$> getLine
main = do
    n <- getInt
    replicateM_ n (solve <$> getInt <*> getLine  >>=  putStrLn . bool "NO" "YES")

{-# LANGUAGE ViewPatterns #-}
import Control.Monad ( replicateM_ )
import Data.Bool ( bool )

solve :: Int -> String -> Bool
solve n str = valid && t == 2 * m
    where
    ((m, t), valid) = foldr validate ((0, 0), True) str

    validate ch (incr ch -> (m, t), valid) =
        ((m, t), valid && (m <= t) && (t - m) <= div n 3)

    incr 'M' (m, t) = (m+1, t)
    incr 'T' (m, t) = (m, t+1)

main = do
    let getInt = read <$> getLine
    n <- getInt
    replicateM_ n $ (solve <$> getInt <*> getLine) >>= putStrLn . bool "NO" "YES"

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Map((!))

solve :: Integer -> [Char] -> Bool
solve _ list
	| numT /= 2*numM = False
	| otherwise = (snd $ test list) && (snd $ test $ reverse list)
	where
		test [] = (0, True)
		test ('M':xs)
			| n == 0 = (0, False)
			| otherwise = (n-1, b)
			where (n, b) = test xs
		test ('T':xs) = (n+1, b)
			where (n, b) = test xs
		numM = sum [1|x<-list, x=='M']
		numT = sum [1|x<-list, x=='T']

showResult :: Bool -> String
showResult True = "YES"
showResult False = "NO"

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine -- >>= return . (fmap read) . words :: IO [Integer]
		putStrLn $ showResult $ solve n a
		loop $ t - 1
	loop t

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    s <- C.getLine
    let work str
          | isNothing result = False
          | otherwise = let Just (x, y) = result in x == y
          where
          acc Nothing _ = Nothing
          acc (Just (x, y)) 'M' = if y <= 0 then Nothing else Just (x + 1, y - 1)
          acc (Just (x, y)) _ = Just (x, y + 1 :: Int)
          result = C.foldl' acc (Just (0, 0)) str
        result = if work s && work (C.reverse s) then "YES" else "NO"
    C.putStrLn $ C.pack result

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    s <- C.getLine
    let acc Nothing _ = Nothing
        acc (Just (x, y)) 'M' = if y <= 0 then Nothing else Just (x + 1, y - 1)
        acc (Just (x, y)) _ = Just (x, y + 1 :: Int)
        result = C.foldl' acc (Just (0, 0)) s
    C.putStrLn $ C.pack $ case result of
      Nothing -> "NO"
      Just (x, y) -> if x == y then "YES"  else "NO"

import Control.Monad ( replicateM_ )
import Data.Bool ( bool )

solve :: Int -> String -> Bool
solve n str = mod n 3 == 0 && all validate (tail $ scanl count (0, 0) str) where
    validate (m, t) = (m <= t) && (t - m) <= div n 3
    count (m, t) 'M' = (m+1, t)
    count (m, t) 'T' = (m, t+1)

main = do
    n <- read <$> getLine
    replicateM_ n $ solve <$> (read <$> getLine) <*> getLine >>= putStrLn . bool "NO" "YES"

import Control.Monad ( replicateM_ )
import Data.Bool ( bool )

solve :: Int -> String -> Bool
solve n str = mod n 3 == 0 && all validate (scanl count (0, 0) str) where
    validate (m, t) = (m <= t) && (t - m) <= div n 3
    count (m, t) 'M' = (m+1, t)
    count (m, t) 'T' = (m, t+1)

main = do
    n <- read <$> getLine
    replicateM_ n $ solve <$> (read <$> getLine) <*> getLine >>= putStrLn . bool "NO" "YES"


Mihai has just learned about the MEX concept and since he liked it so much, he decided to use it right away.Given an array $$$a$$$ of $$$n$$$ non-negative integers, Mihai wants to create a new array $$$b$$$ that is formed in the following way:While $$$a$$$ is not empty:   Choose an integer $$$k$$$ ($$$1 \leq k \leq |a|$$$).  Append the MEX of the first $$$k$$$ numbers of the array $$$a$$$ to the end of array $$$b$$$ and erase them from the array $$$a$$$, shifting the positions of the remaining numbers in $$$a$$$. But, since Mihai loves big arrays as much as the MEX concept, he wants the new array $$$b$$$ to be the lexicographically maximum. So, Mihai asks you to tell him what the maximum array $$$b$$$ that can be created by constructing the array optimally is.An array $$$x$$$ is lexicographically greater than an array $$$y$$$ if in the first position where $$$x$$$ and $$$y$$$ differ $$$x_i > y_i$$$ or if $$$|x| > |y|$$$ and $$$y$$$ is a prefix of $$$x$$$ (where $$$|x|$$$ denotes the size of the array $$$x$$$).The MEX of a set of non-negative integers is the minimal non-negative integer such that it is not in the set. For example, MEX({$$${1, 2, 3}$$$}) $$$= 0$$$ and MEX({$$${0, 1, 2, 4, 5}$$$}) $$$= 3$$$.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the number of elements in the array $$$a$$$. The second line of each test case contains $$$n$$$ non-negative integers $$$a_1, \ldots, a_n$$$ ($$$0 \leq a_i \leq n$$$), where $$$a_i$$$ is the $$$i$$$-th integer from the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print $$$m$$$ — the length of the maximum array $$$b$$$ Mihai can create, followed by $$$m$$$ integers denoting the elements of the array $$$b$$$.

NoteIn the first test case, the lexicographically maximum array $$$b$$$ is obtained by selecting $$$k=5$$$, resulting in the $$$MEX$$$ of the whole array $$$a$$$. It is lexicographically maximum because an array starting with a smaller number than $$$4$$$ is lexicographically smaller, and choosing a $$$k<5$$$ would result in an array starting with a number smaller than $$$4$$$.In the second test case, there are two ways to obtain the maximum array: first selecting $$$k=6$$$, then $$$k=2$$$, or first selecting $$$k=7$$$ and then $$$k=1$$$.

module Main (formBestBFromA, main) where

import Control.Arrow ((&&&))
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set

-- 0 0 2 1 1 1 0 0 1 1
-- [], {}

-- 0 2 1 1 1 0 0 1 1
-- [1], {}

-- 2 1 1 1 0 0 1 1
-- [1, 1], {}

-- 1 1 1 0 0 1 1
-- [1, 1, 0], {2}

-- 1 1 0 0 1 1
-- [2], {2}
-- [3], {}

-- 1 0 0 1 1
-- [3, 0], {1}

-- 0 0 1 1
-- [3, 0, 0], {1}

-- 0 1 1
-- [3, 1], {1}
-- [3, 2], {}

-- 1 1
-- [3, 2, 1], {}

-- 1
-- [3, 2, 2], {}

--
-- [3, 2, 2, 0], {1}

formBestBFromA :: [Integer] -> [Integer]
formBestBFromA = concat . map (\ (k, n) -> replicate (fromIntegral n) k) . Map.toDescList . fst . List.foldl' updateState (Map.empty, Set.empty)
    where
        updateState (current_bs, unused_elements) new_element
            | Map.member new_element current_bs
                = considerUnusedElements (updateBsWithMex (new_element + 1) current_bs, unused_elements)
            | new_element == 0 = (addOne 1 current_bs, unused_elements)
            | otherwise = (addOne 0 current_bs, Set.insert new_element unused_elements)

        addOne k = Map.insertWith (+) k 1
        minKey = fst . Map.findMin

        dropKeysLower x = until (\ m -> Map.null m || minKey m >= x) Map.deleteMin
        takeKeysHigher x = until (\ m -> Map.null m || minKey m > x) Map.deleteMin
        takeElementsHigher x = until (\ s -> Set.null s || Set.findMin s > x) Set.deleteMin

        updateBsWithMex new_mex = addOne new_mex . dropKeysLower new_mex

        considerUnusedElements (current_b, unused_elements)
            | not (null current_b) && Set.member lastB unused_elements
                = updateState (current_b, new_unused_elements) lastB
            | otherwise = (current_b, new_unused_elements)
            where
                lastB = minKey current_b
                new_unused_elements
                    | null current_b = Set.empty
                    | otherwise = takeElementsHigher lastB unused_elements

-- IO Section --

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.concat . map processTest . takeEverySnd . drop 1 . B.lines

takeEverySnd :: [a] -> [a]
takeEverySnd (x1:x2:xs) = x2 : takeEverySnd xs
takeEverySnd xs = []

processTest :: B.ByteString -> B.ByteString
processTest = outputFromB . formBestBFromA . readIntegers
    where
        outputFromB = B.unlines . pairToList . ((bshow . List.genericLength) &&& (B.unwords . map bshow))
        bshow = B.pack . show
        pairToList (a, b) = [a, b]

readIntegers :: B.ByteString -> [Integer]
readIntegers = List.unfoldr (B.readInteger . B.dropWhile Char.isSpace)

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    aLi <- replicateM n getInt
    let
      occs = reverse <$> accumArray (flip (:)) [] (0, n) (zip aLi [1 .. n])
      step :: (Int, Array Int [Int]) -> Maybe (Int, (Int, Array Int [Int]))
      step (j, arr) = if  j == n
        then  Nothing
        else  let
        mex = head [i | (i, []) <- assocs arr]
        j' = foldl' max (j + 1) [head $ arr ! i | i <- [0 .. mex - 1]]
        newArr
          = array (0, mex) [(i, dropWhile (<= j') $ arr ! i) | i <- [0 .. mex]]
        in  Just (mex, (j', newArr))
      ans = unfoldr step (0, occs)
    pure $ putInts [length ans] <> putInts ans

type SP = State P.ByteString
type S = StateT P.ByteString

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

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

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

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

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

module Main (fromBestBFromA, main) where

import qualified Data.ByteString.Char8 as B

import Data.Char (isSpace)
import Data.List (foldl', unfoldr)
import qualified Data.Map as Map
import qualified Data.Set as Set

-- 0 0 2 1 1 1 0 0 1 1
-- [], {}

-- 0 2 1 1 1 0 0 1 1
-- [1], {}

-- 2 1 1 1 0 0 1 1
-- [1, 1], {}

-- 1 1 1 0 0 1 1
-- [1, 1, 0], {2}

-- 1 1 0 0 1 1
-- [2], {2}
-- [3], {}

-- 1 0 0 1 1
-- [3, 0], {1}

-- 0 0 1 1
-- [3, 0, 0], {1}

-- 0 1 1
-- [3, 1], {1}
-- [3, 2], {}

-- 1 1
-- [3, 2, 1], {}

-- 1
-- [3, 2, 2], {}

--
-- [3, 2, 2, 0], {1}

fromBestBFromA :: [Integer] -> [Integer]
fromBestBFromA = concat . map (\ (k, n) -> replicate (fromIntegral n) k) . Map.toDescList . fst . foldl' updateState (Map.empty, Set.empty)
    where
        updateState (current_bs, unused_elements) new_element
            | Map.member new_element current_bs
                = considerUnusedElements (updateBsWithMex (new_element + 1) current_bs, unused_elements)
            | new_element == 0 = (addOne 1 current_bs, unused_elements)
            | otherwise = (addOne 0 current_bs, Set.insert new_element unused_elements)

        addOne k = Map.insertWith (+) k 1
        minKey = fst . Map.findMin

        dropKeysLower x = until (\ m -> Map.null m || minKey m >= x) Map.deleteMin
        takeKeysHigher x = until (\ m -> Map.null m || minKey m > x) Map.deleteMin
        takeElementsHigher x = until (\ s -> Set.null s || Set.findMin s > x) Set.deleteMin

        updateBsWithMex new_mex = addOne new_mex . dropKeysLower new_mex

        considerUnusedElements (current_b, unused_elements)
            | not (null current_b) && Set.member lastB unused_elements
                = updateState (current_b, new_unused_elements) lastB
            | otherwise = (current_b, new_unused_elements)
            where
                lastB = minKey current_b
                new_unused_elements
                    | null current_b = Set.empty
                    | otherwise = takeElementsHigher lastB unused_elements

-- IO Section --

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.unlines . map processTest . takeEverySnd . drop 1 . B.lines

takeEverySnd :: [a] -> [a]
takeEverySnd (x1:x2:xs) = x2 : takeEverySnd xs
takeEverySnd xs = []

processTest :: B.ByteString -> B.ByteString
processTest = B.unwords . map bshow . fromBestBFromA . readIntegers
    where
        bshow = B.pack . show

readIntegers :: B.ByteString -> [Integer]
readIntegers = unfoldr (B.readInteger . B.dropWhile isSpace)

readInteger :: B.ByteString -> Integer
readInteger s = r
    where [r] = readIntegers s

readInt :: B.ByteString -> Int
readInt = fromInteger . readInteger


You've got string s, consisting of small English letters. Some of the English letters are good, the rest are bad.A substring s[l...r] (1 ≤ l ≤ r ≤ |s|) of string s  =  s1s2...s|s| (where |s| is the length of string s) is string  slsl + 1...sr.The substring s[l...r] is good, if among the letters  sl, sl + 1, ..., sr there are at most k bad ones (look at the sample's explanation to understand it more clear).Your task is to find the number of distinct good substrings of the given string s. Two substrings s[x...y] and s[p...q] are considered distinct if their content is different, i.e. s[x...y] ≠ s[p...q].

The first line of the input is the non-empty string s, consisting of small English letters, the string's length is at most 1500 characters. The second line of the input is the string of characters "0" and "1", the length is exactly 26 characters. If the i-th character of this string equals "1", then the i-th English letter is good, otherwise it's bad. That is, the first character of this string corresponds to letter "a", the second one corresponds to letter "b" and so on. The third line of the input consists a single integer k (0 ≤ k ≤ |s|) — the maximum acceptable number of bad characters in a good substring.

Print a single integer — the number of distinct good substrings of string s.

NoteIn the first example there are following good substrings: "a", "ab", "b", "ba", "bab".In the second example there are following good substrings: "a", "aa", "ac", "b", "ba", "c", "ca", "cb".

import qualified Data.Map as M
import Data.Maybe

chars = ['a'..'z']
main = do
    s <- getLine
    bits <- getLine
    k <- getLine
    let good = [(chars !! i, (if (bits !! i) == '1' then 1 else 0)) | i <- [0..25]]
    let ans = solve s good (read k)
    putStrLn $ show ans

data TrieNode = TrieNode
    { cnt:: Int
    , trans :: M.Map Char TrieNode
    } deriving Show

solve :: String -> [(Char, Int)] -> Int -> Int
solve s good k = solve' s good k (TrieNode 0 M.empty)

solve' :: String -> [(Char, Int)] -> Int -> TrieNode -> Int
solve' [] _ _ _ = 0
solve' s@(c:s') good k p =
        solveSingle s good k p' + solve' s' good k p'
    where p' = insert p s

solveSingle :: String -> [(Char, Int)] -> Int -> TrieNode -> Int
solveSingle s good k p = ans
    where
        (ans, bad, p') = foldl func (0, 0, p) s
        func (ans, bad, p) c = let
            bad' = bad + 1 - (fromJust $ lookup c good)
            ans' = ans + (if bad' <= k && cnt p' == 1 then 1 else 0)
            p' = fromJust $ M.lookup c (trans p)
            in (ans', bad', p')

insert :: TrieNode -> String -> TrieNode
insert p [] = p
insert p (c:s') = p { trans = M.insert c p' (trans p) }
    where
        p' = case M.lookup c (trans p) of
                Nothing -> insert (TrieNode 1 M.empty) s'
                Just pc -> insert (pc { cnt = (cnt pc) + 1 }) s'

{-# OPTIONS_GHC -O2  -funbox-strict-fields #-}

import Data.Array.Base
import qualified Data.Map as M
import Data.List

main = do
  cs <- getLine
  isGood <- fmap(listArray('a','z').map('1'==))getLine
  k <- readLn
  print $ solve k cs isGood

data Trie = Node !Int !(M.Map Char Trie)

solve :: Int -> String -> UArray Char Bool -> Int
solve k cs arr = pred.cnt $ foldl' (flip ins) (Node 0 M.empty) $ tails cs
   where
     isGood c = unsafeAt arr $ fromEnum c - 97

     ins :: String -> Trie -> Trie
     ins (c:cs) (Node cnt f)
       | Just trie <- M.lookup c f = Node cnt (M.insert c (ins cs trie) f)
       | isGood c = Node cnt (M.insert c (ins cs (Node cnt     M.empty)) f)
       | cnt < k  = Node cnt (M.insert c (ins cs (Node (cnt+1) M.empty)) f)
     ins _ trie = trie

     cnt :: Trie -> Int
     cnt (Node _ f) = M.foldr' ((+).cnt) 1 f

import Data.List
import Data.Char (digitToInt)

main = do
    s <- getLine
    t <- getLine
    k <- readLn
    print $ solve (map ((1-) . digitToInt) t) k s

pairwise l@(_:ht) = zip l ht
common pre post = length $ (takeWhile eq) $ zip pre post
    where eq (k1, k2) = k1 == k2

solve t k = sum . (map pair) . pairwise . sort . tails
    where
        bad ch = t !! (fromEnum ch - 97)
        pair (pre, post) = length $ takeWhile (<= k) $ tail accum
            where
                delta = (common pre post)
                stop = sum $ map bad $ take delta post
                accum = scanl (+) stop $ map bad $ drop delta post

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

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString as B
import Data.STRef
import Data.Word

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

type Hash = Word32

base1,base2 :: Hash
base1 = 1000000007
base2 =  999999937

mask :: Hash
mask = 0x3fffffff

main = do
  cs <- fmap (map $ fromIntegral.fromEnum) getLine
  isBad <- fmap(listArray('a','z').map(fromEnum.('0'==)))getLine
  k <- readLn
  print $ solve k cs isBad

solve :: Int -> [Hash] -> UArray Char Int -> Int
solve k cs isBad = runST $ do
  res <- newSTRef 0 :: ST s (STRef s Int)
  hashtable1 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  hashtable2 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  let f ccs@(_:cs) = g 0 0 0 ccs >> f cs
      f [] = readSTRef res
      g !hash1 !hash2 !cnt (c:cs) = do
        let cnt' = (cnt+).unsafeAt isBad $ fromIntegral c - 97
        when (cnt'<=k) $ do
          let !h1 = (hash1 * base1 + c) .&. mask
              !h2 = (hash2 * base2 + c) .&. mask
          flg1 <- unsafeRead hashtable1 $ fromIntegral h1
          flg2 <- unsafeRead hashtable2 $ fromIntegral h2
          unless (flg1 && flg2) $ do
            modifySTRef' res (1+)
            unsafeWrite hashtable1 (fromIntegral h1) True
            unsafeWrite hashtable2 (fromIntegral h2) True
          g h1 h2 cnt' cs
      g _ _ _ _ = return ()
  f cs

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

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString as B
import Data.STRef
import Data.Word

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

type Hash = Word32

base1,base2 :: Hash
base1 = 1000000007
base2 = 99991

mask :: Hash
mask = 0x3fffffff

main = do
  cs <- fmap (map $ fromIntegral.fromEnum) getLine
  isBad <- fmap(listArray('a','z').map(fromEnum.('0'==)))getLine
  k <- readLn
  print $ solve k cs isBad

solve :: Int -> [Hash] -> UArray Char Int -> Int
solve k cs isBad = runST $ do
  res <- newSTRef 0 :: ST s (STRef s Int)
  hashtable1 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  hashtable2 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  let f ccs@(_:cs) = g 0 0 0 ccs >> f cs
      f [] = readSTRef res
      g !hash1 !hash2 !cnt (c:cs) = do
        let cnt' = (cnt+).unsafeAt isBad $ fromIntegral c - 97
        when (cnt'<=k) $ do
          let !h1 = (hash1 * base1 + c) .&. mask
              !h2 = (hash2 * base2 + c) .&. mask
          flg1 <- unsafeRead hashtable1 $ fromIntegral h1
          flg2 <- unsafeRead hashtable2 $ fromIntegral h2
          unless (flg1 && flg2) $ do
            modifySTRef' res (1+)
            unsafeWrite hashtable1 (fromIntegral h1) True
            unsafeWrite hashtable2 (fromIntegral h2) True
          g h1 h2 cnt' cs
      g _ _ _ _ = return ()
  f cs

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

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString as B
import Data.STRef
import Data.Word

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

type Hash = Word32

base1,base2 :: Hash
base1 = 1000000007
base2 = 997

mask :: Hash
mask = 0x3fffffff

main = do
  cs <- fmap (map $ fromIntegral.fromEnum) getLine
  isBad <- fmap(listArray('a','z').map(fromEnum.('0'==)))getLine
  k <- readLn
  print $ solve k cs isBad

solve :: Int -> [Hash] -> UArray Char Int -> Int
solve k cs isBad = runST $ do
  res <- newSTRef 0 :: ST s (STRef s Int)
  hashtable1 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  hashtable2 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  let f ccs@(_:cs) = g 0 0 0 ccs >> f cs
      f [] = readSTRef res
      g !hash1 !hash2 !cnt (c:cs) = do
        let cnt' = (cnt+).unsafeAt isBad $ fromIntegral c - 97
        when (cnt'<=k) $ do
          let !h1 = (hash1 * base1 + c) .&. mask
              !h2 = (hash2 * base2 + c) .&. mask
          flg1 <- unsafeRead hashtable1 $ fromIntegral h1
          flg2 <- unsafeRead hashtable2 $ fromIntegral h2
          unless (flg1 && flg2) $ do
            modifySTRef' res (1+)
            unsafeWrite hashtable1 (fromIntegral h1) True
            unsafeWrite hashtable2 (fromIntegral h2) True
          g h1 h2 cnt' cs
      g _ _ _ _ = return ()
  f cs

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

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString as B
import Data.STRef
import Data.Word

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

type Hash = Word32

base1,base2 :: Hash
base1 = 1000000007
base2 = 1000000009

mask :: Hash
mask = 0x1fffffff

main = do
  cs <- fmap (map $ fromIntegral.fromEnum) getLine
  isBad <- fmap(listArray('a','z').map(fromEnum.('0'==)))getLine
  k <- readLn
  print $ solve k cs isBad

solve :: Int -> [Hash] -> UArray Char Int -> Int
solve k cs isBad = runST $ do
  res <- newSTRef 0 :: ST s (STRef s Int)
  hashtable1 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  hashtable2 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  let f ccs@(_:cs) = g 0 0 0 ccs >> f cs
      f [] = readSTRef res
      g !hash1 !hash2 !cnt (c:cs) = do
        let cnt' = (cnt+).unsafeAt isBad $ fromIntegral c - 97
        when (cnt'<=k) $ do
          let !h1 = (hash1 * base1 + c) .&. mask
              !h2 = (hash2 * base2 + c) .&. mask
          flg1 <- unsafeRead hashtable1 $ fromIntegral h1
          flg2 <- unsafeRead hashtable2 $ fromIntegral h2
          unless (flg1 && flg2) $ do
            modifySTRef' res (1+)
            unsafeWrite hashtable1 (fromIntegral h1) True
            unsafeWrite hashtable2 (fromIntegral h2) True
          g h1 h2 cnt' cs
      g _ _ _ _ = return ()
  f cs

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

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString as B
import Data.STRef
import Data.Word

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

type Hash = Word32

base1,base2 :: Hash
base1 = 1000000007
base2 = 100000007

mask :: Hash
mask = 0x3fffffff

main = do
  cs <- fmap (map $ fromIntegral.fromEnum) getLine
  isBad <- fmap(listArray('a','z').map(fromEnum.('0'==)))getLine
  k <- readLn
  print $ solve k cs isBad

solve :: Int -> [Hash] -> UArray Char Int -> Int
solve k cs isBad = runST $ do
  res <- newSTRef 0 :: ST s (STRef s Int)
  hashtable1 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  hashtable2 <- newArray (0,mask) False :: ST s (STUArray s Hash Bool)
  let f ccs@(_:cs) = g 0 0 0 ccs >> f cs
      f [] = readSTRef res
      g !hash1 !hash2 !cnt (c:cs) = do
        let cnt' = (cnt+).unsafeAt isBad $ fromIntegral c - 97
        when (cnt'<=k) $ do
          let !h1 = (hash1 * base1 + c) .&. mask
              !h2 = (hash2 * base2 + c) .&. mask
          flg1 <- unsafeRead hashtable1 $ fromIntegral h1
          flg2 <- unsafeRead hashtable2 $ fromIntegral h2
          unless (flg1 && flg2) $ do
            modifySTRef' res (1+)
            unsafeWrite hashtable1 (fromIntegral h1) True
            unsafeWrite hashtable2 (fromIntegral h2) True
          g h1 h2 cnt' cs
      g _ _ _ _ = return ()
  f cs


The circle line of the Berland subway has n stations. We know the distances between all pairs of neighboring stations: d1 is the distance between the 1-st and the 2-nd station; d2 is the distance between the 2-nd and the 3-rd station;... dn - 1 is the distance between the n - 1-th and the n-th station; dn is the distance between the n-th and the 1-st station.The trains go along the circle line in both directions. Find the shortest distance between stations with numbers s and t.

The first line contains integer n (3 ≤ n ≤ 100) — the number of stations on the circle line. The second line contains n integers d1, d2, ..., dn (1 ≤ di ≤ 100) — the distances between pairs of neighboring stations. The third line contains two integers s and t (1 ≤ s, t ≤ n) — the numbers of stations, between which you need to find the shortest distance. These numbers can be the same. The numbers in the lines are separated by single spaces.

Print a single number — the length of the shortest path between stations number s and t.

NoteIn the first sample the length of path 1 → 2 → 3 equals 5, the length of path 1 → 4 → 3 equals 13.In the second sample the length of path 4 → 1 is 100, the length of path 4 → 3 → 2 → 1 is 15.In the third sample the length of path 3 → 1 is 1, the length of path 3 → 2 → 1 is 2.In the fourth sample the numbers of stations are the same, so the shortest distance equals 0.

main = do
	n<-getLine
	ds<-getLine
	st<-getLine
	let [s,t] = map read $ words st
	putStrLn $ show $ solve (read n) (map read (words ds)) s t

solve::Int->[Int]->Int->Int->Int
solve n d s t | s==t = 0
              | otherwise = min (sum $ drop (min s t -1) $ take (max s t-1)  d) (sum $ take (min s t-1) d ++ drop (max s t-1) d)
                where dist = abs (s-t)

import Data.List

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

solve :: [[Int]] -> Int
solve (_ : ds : st : _) = min a b
  where
  (s : t : _) = sort st
  a = sum $ drop (s - 1) $ take (t - 1) ds
  b = sum ds - a

module Main (
    main
) where

import Data.List

solve nums s t =
    let hs = take s nums in
    let ts = drop t nums in
    let ms = drop s (take t nums) in
    let sum1 = sum hs + sum ts in
    let sum2 = sum ms in
    min sum1 sum2

main = do
    getLine
    numsStr <- getLine
    let nums = map read $ words numsStr
    stStr <- getLine
    let [s,t] = sort $ map read $ words stStr
    print (solve nums (s-1) (t-1))

import Control.Monad (liftM)
import Data.List (nub)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> Int -> [Int] -> Int
solve s t xs  =  min a b
  where
    a  =  sum $ drop (s - 1) $ take (t - 1) xs
    b  =  sum xs - a

main :: IO ()
main  =  do
    getLine
    xs  <-  reads
    [t, s]  <-  reads
    print $ solve (min t s) (max t s) xs

-- Codeforces 278A

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    path <- fmap (map read . words) getLine :: IO [Int]
    aim <- fmap (map read . words) getLine :: IO [Int]
    print $ solve n (concat $ replicate 2 path) (sort aim) where
        solve n xs [s, t] = min (len s t) (len t (s+n)) where
            len a b = sum $ take (b-a) $ drop (a-1) xs

import Control.Applicative

parseLine = map read . words <$> getLine

main = do
  n <- read <$> getLine
  xs <- parseLine
  [x,y] <- parseLine
  let cyc = cycle xs
      (mn,mx) = (min x y, max x y)
      n1 = sum . take (mx-mn) . drop (mn-1)   $ cyc
      n2 = sum . take (n+mn-mx) . drop (mx-1) $ cyc
  print $ min n1 n2

import Control.Arrow ((***))

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

solve :: [[Int]] -> Int
solve [[n], ds, [s, t]] | s == t = 0
                        | otherwise = uncurry min $ (sum *** sum) $ splitAt (max s t - min s t)
                                    $ take n $ drop (min s t - 1) $ ds ++ ds
solve _ = undefined

import Control.Arrow ((***))

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

solve :: [[Int]] -> Int
solve [[n], ds, [s, t]]
  | s == t = 0
  | otherwise = uncurry min $ (sum *** sum) $ splitAt (max s t - min s t)
              $ take n $ drop (min s t - 1) $ cycle ds
solve _ = undefined

main = do
    getLine
    d <- fmap (map read . words) getLine
    [s, t] <- fmap (map read . words) getLine
    print $ solve d s t
solve d s t | s == t = 0
            | s > t = solve d t s
            | s < t = min fwdWay $ sum d - fwdWay
            where fwdWay = forward d s t
forward d s t = sum . take (t-s) . drop (s-1) $ d

import Data.List
main=interact$show.f.map read.words
f(n:tmp) = min d $ sum ds - d
   where
     (ds,st) = splitAt n tmp
     [s,t] = sort st
     d = sum.take(t-s)$drop(s-1)ds

module Main where

import Data.List

main = do
     distances <- getLine >> getLine >>= (return . map read . words) :: IO [Int]
     [s1, s2] <- getLine >>= (return . sort . map read . words) :: IO [Int]
     let total = sum distances
         dist = sum $ drop (s1 - 1) $ take (s2 - 1) distances
     print $ min dist (total - dist)

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

main= do
	getLine
	t<- map read. words <$> getLine::IO [Int]
	x<- map read.words <$> getLine::IO [Int]
	let s= minimum x
	let e = maximum x
	let ans1 = sum $ take (e-s) $ drop (s-1) t
	let ans2 = (sum t)- ans1
	print $ min ans1 ans2

import Control.Monad
import Data.List

main = getLine >>  replicateM 2 getLine
               >>= return . map (map read . words)
               >>= putStrLn . show . solve

solve :: [[Int]] -> Int
solve [ds, (a:b:ot)] = min ar $ foldl1 (+) ds - ar
            where ar = foldl (+) 0 $ clip (pred a) (pred b) ds

clip :: Int -> Int -> [a] -> [a]
clip a b = drop from . take to
  where from = min a b
        to   = max a b

module Main (
    main
) where

import Data.List

solve nums s t =
    let hs = take s nums in
    let ts = drop t nums in
    let ms = drop s (take t nums) in
    let sum1 = sum hs + sum ts in
    let sum2 = sum ms in
    min sum1 sum2

main = do
    getLine
    numsStr <- getLine
    let nums = map read $ words numsStr
    stStr <- getLine
    let [s,t] = map read $ words stStr
    print (solve nums (s-1) (t-1))

import Control.Arrow ((***))

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

solve :: [[Int]] -> Int
solve [[n], ds, [s, t]] | s == t = 0
                        | otherwise = uncurry min $ (sum *** sum) $ splitAt (max s t - min s t)
                                    $ take (min s t + n - 1) $ drop (min s t - 1) $ ds ++ ds
solve _ = undefined

import Data.List (unfoldr)

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

solve :: [[Int]] -> Int
solve [[n], ds, [s, t]] | s == t = 0
                        | otherwise = minimum $ map sum $ splitN (max s t - 1)
                                    $ take (min s t + n - 1) $ drop (min s t - 1) $ ds ++ ds
solve _ = undefined

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

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

main= do
	getLine
	t<- map read. words <$> getLine::IO [Int]
	x<- map read.words <$> getLine::IO [Int]
	let s= minimum x
	let e = maximum x
	let ans1 = sum $ take (e-1) $ drop (s-1) t
	let ans2 = (sum t)- ans1
	print $ min ans1 ans2