import Data.List
import Data.Maybe
import qualified Data.IntMap.Strict as M
import qualified Data.ByteString.Char8 as B

readInt = fst . fromJust . B.readInt

apply n f x = foldr ($) x (replicate n f)

main = do
 n <- readLn
 as <- map readInt . B.words <$> B.getLine
 let (as1,as2) = splitAt n as
 let q1 = M.fromListWith (+) (zip as1 (repeat 1))
 let q2 = M.fromListWith (+) (zip as2 (repeat 1))
 print (n3 n q1 as2 q2)

n3 n q1 as2 q2 = maximum (fsearch n q1 as2 q2)

fsearch n q1 as q2 = do
 k <- [0..n]
 let (rh,rl) = transfer (n-k) k q1 as q2
 return (rh - rl)

pred' v = if v > 1 then Just (pred v) else Nothing

transfer n' 0 q1 _ q2 = (sumq q1, sumq (apply n' (M.updateMax pred') q2))
 where sumq = sum . map (uncurry (*)) . M.toList

transfer n' k q1 (a:as) q2 = transfer n' (k-1) (M.insertWith (+) a 1 q1') as q2'
 where
  q1' = M.updateMin pred' q1
  q2' = M.update pred' a q2


import Data.List
import qualified Data.Set as S

apply n f x = foldr ($) x (replicate n f)

main = do
 n <- readLn
 as <- map read . words <$> getLine
 print (n3 n as)

n3 n as = maximum (fsearch n q1 (zip as2 [0..]) q2)
 where
  (as1,as2) = splitAt n as
  q1 = S.fromList (zip as1 [0..])
  q2 = S.fromList (zip as2 [0..])

fsearch n q1 ais q2 = do
 let rh0 = sum (map fst (S.elems q1))
 let rl0 = sum (map fst (S.elems q2))
 k <- [0..n]
 let (rh,rl) = transfer (n-k) k (rh0,q1) ais (rl0,q2)
 return (rh - rl)

transfer n' 0 (rh,_) _ (rl,q2) = let (rl',_) = apply n' delmax (rl,q2) in (rh,rl')
 where
  delmax (m,q) = let ((vmax,_),q') = S.deleteFindMax q in (m-vmax,q')

transfer n' k (rh,q1) ((a,i2):ais) (rl,q2) = transfer n' (k-1) (rh-vmin+a, S.insert (a,i1) q1') ais (rl-a,q2')
 where
  ((vmin,i1),q1') = S.deleteFindMin q1
  q2' = S.delete (a,i2) q2

Global OOD problem IDs are disjoint from train, validation, and in-distribution test problem IDs.

Score : 500 points

Problem Statement

Let N be a positive integer.

There is a numerical sequence of length 3N, a = (a_1, a_2, ..., a_{3N}).
Snuke is constructing a new sequence of length 2N, a', by removing exactly N elements from a without changing the order of the remaining elements.
Here, the score of a' is defined as follows: (the sum of the elements in the first half of a') - (the sum of the elements in the second half of a').

Find the maximum possible score of a'.

Constraints

1 ≤ N ≤ 10^5

a_i is an integer.

1 ≤ a_i ≤ 10^9

Partial Score

In the test set worth 300 points, N ≤ 1000.

Input

Input is given from Standard Input in the following format:

N
a_1 a_2 ... a_{3N}

Output

Print the maximum possible score of a'.

Sample Input 1

2
3 1 4 1 5 9

Sample Output 1

1

When a_2 and a_6 are removed, a' will be (3, 4, 1, 5), which has a score of (3 + 4) - (1 + 5) = 1.

Sample Input 2

1
1 2 3

Sample Output 2

-1

For example, when a_1 are removed, a' will be (2, 3), which has a score of 2 - 3 = -1.

Sample Input 3

3
8 2 2 7 4 6 5 3 8

Sample Output 3

5

For example, when a_2, a_3 and a_9 are removed, a' will be (8, 7, 4, 6, 5, 3), which has a score of (8 + 7 + 4) - (6 + 5 + 3) = 5.

Submitted source-code file size, in bytes.

Execution CPU time reported by official Project CodeNet metadata, in milliseconds.

Peak memory usage reported by official Project CodeNet metadata, in kilobytes.


import Control.Monad
import qualified Data.Map as M
import Data.Maybe

-- pairing heap
-----------------------------------------------------
data Heap a = Empty | Heap a [(Heap a)] deriving Show

findMin :: Heap a -> a
findMin (Heap h _) = h

merge :: Ord a => Heap a -> Heap a -> Heap a
merge Empty h = h
merge h Empty = h
merge h1@(Heap x hs1) h2@(Heap y hs2)
  | x < y = Heap x (h2:hs1)
  | otherwise = Heap y (h1:hs2)

mergePairs :: Ord a => [Heap a] -> Heap a
mergePairs [] = Empty
mergePairs [h] = h
mergePairs (h1:h2:hs) = merge (merge h1 h2) (mergePairs hs)

insert :: Ord a => a -> Heap a -> Heap a
insert x h = merge (Heap x []) h

deleteMin :: Ord a => Heap a -> Heap a
deleteMin (Heap x hs) = mergePairs hs

fromList :: Ord a => [a] -> Heap a
fromList [] = Empty
fromList (x:xs) = merge (Heap x []) (fromList xs)
-----------------------------------------------------

{-
-- bag
-----------------------------------------------------
type Bag = M.Map Int Int

findMin :: Bag -> Int
findMin bag = fst $ M.findMin bag

findMax :: Bag -> Int
findMax bag = fst $ M.findMax bag

delete :: Int -> Bag -> Bag
delete element bag = newbag
  where quantity = fromMaybe (-1) $ M.lookup element bag
        newbag = if quantity == -1 then bag
                    else if quantity > 1 then M.insertWith (flip (-)) element 1 bag
                            else M.delete element bag

insert :: Int -> Bag -> Bag
insert element bag = M.insertWith (+) element 1 bag

fromList :: [Int] -> Bag
fromList xs = M.fromList $ zip xs (replicate (length xs) 1)
-----------------------------------------------------

sum_large_n :: Bag -> Int -> Int
sum_large_n _ 0 = 0
sum_large_n bag n = (largest + sum_large_n newbag (n - 1))
  where largest = findMax bag
        newbag = delete largest bag

sum_small_n :: Bag -> Int -> Int
sum_small_n _ 0 = 0
sum_small_n bag n = smallest + sum_small_n newbag (n - 1)
  where smallest = findMin bag
        newbag = delete smallest bag

iterate_l :: Int -> [Int] -> Bag -> [Int]
iterate_l _ [] _ = []
iterate_l n (x:xs) bag = ans:iterate_l n xs newbag
  where ans = sum_large_n newbag n
        newbag = insert x bag

iterate_r :: Int -> [Int] -> Bag -> [Int]
iterate_r _ [] _ = []
iterate_r n (x:xs) bag = ans:iterate_r n xs newbag
  where ans = sum_small_n newbag n
        newbag = insert x bag
-}

sum_large_n :: Heap Int -> Int -> Int
sum_large_n _ 0 = 0
sum_large_n h n = ((-largest) + sum_large_n newh (n - 1))
  where largest = findMin h
        newh = deleteMin h

sum_small_n :: Heap Int -> Int -> Int
sum_small_n _ 0 = 0
sum_small_n h n = (smallest + sum_small_n newh (n - 1))
  where smallest = findMin h
        newh = deleteMin h

iterate_l :: Int -> [Int] -> Heap Int -> [Int]
iterate_l _ [] _ = []
iterate_l n (x:xs) h = ans:iterate_l n xs newh
  where ans = sum_large_n newh n
        newh = insert (-x) h

iterate_r :: Int -> [Int] -> Heap Int -> [Int]
iterate_r _ [] _ = []
iterate_r n (x:xs) h = ans:iterate_r n xs newh
  where ans = sum_small_n newh n
        newh = insert x h

main = do
  [n] <- map read . words <$> getLine :: IO [Int]
  in_seq <- map read . words <$> getLine :: IO [Int]
  let left_seq = take n in_seq
  let right_seq = drop (2 * n) in_seq
  let mid_seq = take n $ drop n in_seq
  let mid_r_seq = reverse mid_seq

  let left_init = sum left_seq
  let m_l_seq = left_init:iterate_l n mid_seq (fromList $ map (*(-1)) left_seq)

  let right_init = sum right_seq
  let m_r_seq = right_init:iterate_r n mid_r_seq (fromList right_seq)

  let ans = maximum (zipWith (\a b -> a - b) m_l_seq (reverse m_r_seq))

  print ans


import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe

main = do
  s <- getLine
  let numA = minimum $ elemIndices 'A' s
  let numZ = (+1) $maximum $ elemIndices 'Z' s
  print $ (length .drop numA .take numZ) s

Score : 200 points

Problem Statement

Snuke has decided to construct a string that starts with A and ends with Z, by taking out a substring of a string s (that is, a consecutive part of s).

Find the greatest length of the string Snuke can construct. Here, the test set guarantees that there always exists a substring of s that starts with A and ends with Z.

Constraints

1 ≦ |s| ≦ 200{,}000

s consists of uppercase English letters.

There exists a substring of s that starts with A and ends with Z.

Input

The input is given from Standard Input in the following format:

s

Output

Print the answer.

Sample Input 1

QWERTYASDFZXCV

Sample Output 1

5

By taking out the seventh through eleventh characters, it is possible to construct ASDFZ, which starts with A and ends with Z.

Sample Input 2

ZABCZ

Sample Output 2

4

Sample Input 3

HASFJGHOGAKZZFEGA

Sample Output 3

12


import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe

main = do
  s <- getLine
  let numA = minimum $ elemIndices 'A' s
  let numZ = (+1) $maximum $ elemIndices 'Z' s
  print $ (drop numA .take numZ) s


import qualified Data.ByteString.Char8 as B
main=print.f=<<B.getLine
f=B.length.B.dropWhile(/='Z').B.reverse.B.dropWhile(/='A')


import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  bs <- BS.getLine :: IO BS.ByteString
  let l = BS.length . BS.dropWhile (/='Z') . BS.reverse . BS.dropWhile (/='A')
  print $ l bs


import Data.List
import Data.Maybe

main :: IO()
main = do
    s <- getLine
    let a = elemIndex 'A' s
    let z = elemIndex 'Z' (reverse s)
    putStrLn $ show $ fromJust a - fromJust z + length s


import Data.List
import Data.Maybe

main :: IO()
main = do
    s <- getLine
    let a = elemIndex 'a' s
    let z = elemIndex 'z' (reverse s)
    putStrLn $ show $ fromJust a - fromJust z + length s


import Data.List
import Data.Maybe

main = do
    s <- getLine
    let a = elemIndex 'a' s
    let z = elemIndex 'z' (reverse s)
    print $ "Hello"
    -- putStrLn $ show $ fromJust a - fromJust z + length s


f s
 |null s=False
 |head s=='A'&&last s=='Z'=True
 |otherwise=False
main=do
 s<-getLine
 let l=length s
 print$maximum$map length$filter(f)[drop y(take x s)|x<-[0..l],y<-[0..l],y<x]


import Data.List
main :: IO ()
main = getLine >>= print . length . dropWhile (/='A') . dropWhileEnd (/='Z')


main = getLine >>= print . length . dropWhile (/='Z') . reverse . dropWhile (/='A')


main=getLine>>=print.f 0 200000 0
f i a z[]=z-a+1
f i a z(s:x)=f(i+1)(if s=='A'then min a i else a)(if s=='Z' then i else z)x


main :: IO ()
main = print =<< solve <$> getLine

solve :: String -> Int
solve = length . dropWhile (/= 'Z') . reverse . dropWhile (/= 'A')


import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import Data.Array
strToInt s = (read :: String -> Int) s

main = do
    s <- getLine
    print $ (length s) - (f (elemIndex 'Z' (reverse s))) - (f (elemIndex 'A' s))

f :: Maybe Int -> Int
f (Just n) = n
f Nothing  = 0


import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Text.Printf
import Debug.Trace

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

substr :: Int -> Int -> B.ByteString -> B.ByteString
substr b l s = B.take l $ B.drop b s

main = do
  s <- B.getLine
  let b = fromJust $ 'A' `B.elemIndex` s
  let e = B.length s - (fromJust $ B.elemIndex 'Z' $ B.reverse s)
  print $ e-b


import Data.List
main = getLine >>= print . (\x -> last (elemIndices 'Z' x) - head (elemIndices 'A' x) + 1)


import Data.List
main = getLine >>= print . solve

solve :: String -> Int
solve = length . dropWhile ( /= 'Z') . reverse . dropWhile (/= 'A')


import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe

main = do
  [k,s] <- map (read::String->Int) . words <$> getLine
  print $ length [(x,y,z)|x<-[0..k], y<-[0..k], z<-[0..k], x+y+z==s]

Score : 200 points

Problem Statement

You are given two integers K and S.

Three variable X, Y and Z takes integer values satisfying 0≤X,Y,Z≤K.

How many different assignments of values to X, Y and Z are there such that X + Y + Z = S?

Constraints

2≤K≤2500

0≤S≤3K

K and S are integers.

Input

The input is given from Standard Input in the following format:

K S

Output

Print the number of the triples of X, Y and Z that satisfy the condition.

Sample Input 1

2 2

Sample Output 1

6

There are six triples of X, Y and Z that satisfy the condition:

X = 0, Y = 0, Z = 2

X = 0, Y = 2, Z = 0

X = 2, Y = 0, Z = 0

X = 0, Y = 1, Z = 1

X = 1, Y = 0, Z = 1

X = 1, Y = 1, Z = 0

Sample Input 2

5 15

Sample Output 2

1

The maximum value of X + Y + Z is 15, achieved by one triple of X, Y and Z.


main = do
    [k,s] <- map read . words <$> getLine

    print $ length [[x,y] | x <- [0..k], y <- [0..k], s - x - y  >= 0, s - x - y <= k]


main=print.solve.map read.words=<<getLine
solve[k,s]=length[(x,y,z)|x<-[0..k],y<-[0..k],let z=s-x-y,0<=z && z<=k]


main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  putStrLn . show . length $ [(x,y,z) | x <- [0..k], y <- [0..k], let z = s-x-y, x+y+z == s]


main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  putStrLn . show . length $ [(x,y,z) | x <- [0..k], y <- [0..k], z <- [0..k], x + y + z == s]


main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  putStrLn . show $ [(x,y,z) | x <- [0..k], y <- [0..k], z <- [0..k], x + y + z == s]


main = interact $ show . sol . fmap read . words

sol [k,s]
  | s <= k    = f s
  | s >= 2*k  = f (3*k-s)
  | otherwise = (k+1)^2 - f (s-k-1) - f (2*k-s-1)

f x = (x+1)*(x+2) `div` 2


module Main where

import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Maybe (fromJust)
import Data.List (unfoldr)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  [k,s] <- readIntList . head <$> plainInputs
  print $ sum $ tiles k s

tiles :: Int -> Int -> [Int]
tiles k s = do
  x <- [0..lim s]
  y <- [0..lim (s-x)]
  pure $ bool 0 1 $ inbound (s-x-y)
  where
    inbound a = 0 <= a && a <= k
    lim a = min a k

-- utils
readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt

readIntList :: BS.ByteString -> [Int]
readIntList = unfoldr (BS.readInt . BS.dropWhile isSpace)

plainInputs :: IO [BS.ByteString]
plainInputs = BS.lines <$> BS.getContents


module Main where

import Data.Char (isSpace)
import Data.Maybe (fromJust)
import Data.List (unfoldr, nub)
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  [k,s] <- readIntList . head <$> plainInputs
  print $ length $ nub $ filter (bounds s) $ tiles k s
  where
    bounds s (x,y,z) = x + y + z == s

tiles :: Int -> Int -> [(Int,Int,Int)]
tiles k s = do
  x <- [0..lim s]
  y <- [0..lim (s-x)]
  pure (x,y,min (s-x-y) k)
  where
    lim a = min a k

-- utils
readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt

readIntList :: BS.ByteString -> [Int]
readIntList = unfoldr (BS.readInt . BS.dropWhile isSpace)

plainInputs :: IO [BS.ByteString]
plainInputs = BS.lines <$> BS.getContents


main :: IO ()
main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  let z_xpy = zip [0..k] [xpy | z <- [0..k], let xpy = s-z]
  let yz = [(y, z) | y <- [0..k], (z, xpy) <- z_xpy, xpy - y >= 0]
  let x = [a |(y, z) <- yz, let a = s-z-y, a >=0 && a<= k]
  print $ length x


main :: IO ()
main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  let ss = [x+y+z | x <- [0..k], y <- [0..k], z <- [0..k]]
  print $ length $ filter (==s) ss


module Main where

import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS
bytestr2Int = fst . fromJust . BS.readInt
getInt = bytestr2Int <$> BS.getLine
getIntL_H = map bytestr2Int. BS.words <$> BS.getLine
getIntL_V n = replicate n $ getInt
getInt2D n = replicate n $ getIntL_H

data Curr = Zero
          | One Int
          | Two Int Int
          | Filled Int Int Int
          deriving (Show)

main :: IO ()
main = do
    [k,s] <- getIntL_H
    print $ check k s 0 Zero

check k s a c =
    if k<a then
        []
    else case c of
        Zero -> next c (One a)
        (One x) -> next c (Two x a)
        (Two x y) -> if a==s
            then
                next c (Filled x y a)
            else
                check k s (a+1) c
        _ -> [c]
    where
        next rm ad = check k s (a+1) rm ++ check k (s-a) 0 ad


main :: IO ()
main = do
  [k, s] <- map read . words <$> getLine
  print . length $ [(x, y, z) | x <- [0..k], y <- [0..k], z <- [0..(s - x - y)], x + y + z == s]


main :: IO ()
main = do
  [k, s] <- map read . words <$> getLine
  print . length $ [(x, y, z) | x <- [0..k], y <- [0..k], z <- [0..k], x + y + z == s]


rekkyo :: Integer -> Integer -> [(Integer,Integer)]
rekkyo n k = [(x,y)|(x,y) <- doubles n,check(x,y,k,n)]

doubles :: Integer -> [(Integer,Integer)]
doubles n = [(x,y)|x <- [0..n],y <- [0..n]]

check :: (Integer,Integer,Integer,Integer) -> Bool
check(x,y,k,n) =((0 <= k-x-y) && (k-x-y <= n))

main = do
    [n,k] <- map read . words <$> getLine
    let res = rekkyo n k
    print (length res)


import qualified Data.Set as Set
main = do
    [k,s] <- map read . words <$> getLine
    let a = [ x + y | x <- [0..k], y <- [0..k], x + y <= s ]
        k'= Set.fromList [0..k]
    print $ length [ 1 | xy <- a, Set.member (s - xy) k']


main = do
    [k,s] <- map read . words <$> getLine
    let a = [ x + y | x <- [0..k], y <- [0..k], x + y <= s ]
    print $ length [ 1 | xy <- a, (s - xy) `elem` [0..k]]


import Data.List
import Control.Applicative

main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]
  print $ sum
   $ map (\x -> 1-s+x+k+k)
          [max 0 (s-k-k)..min k (s-k)]
   ++ map (\x -> 1+s-x)
           [max 0 (s-k+1)..min k (s-0-0)]


import Data.List
import Control.Applicative

main = do
  [k,s] <- map read . words <$> getLine
  print $ sum $ (`map` [max 0 (s-k-k)..min k (s-0-0)])
   $ \x -> 1 - max 0 (s-x-k) + min k (s-x-0)


main = do
    [k, s] <- map read . words <$> getLine
    print $ length $ filter (== True) [ x + y + z == s | x <- [0..k], y <- [0..k-x], z <- [0..k-x-y]]


main :: IO()
main = do
    [k,s] <- map read . words <$> getLine
    print $ length [()| x <- [0..k], y <- [0..(min (s-x) k)],let z = s - x - y, elem z [0..k]]


import           Control.Applicative
import           Control.Monad
import           Data.List.Split

getResult :: Int -> Int -> Int
getResult k s = length
  [ (x, y, z) | x <- [0 .. k], y <- [0 .. k], z <- [0 .. k], x + y + z == s ]

main :: IO ()
main = do
  input <- getLine
  let nums = map read (splitOn " " input) :: [Int]
  print $ getResult (head nums) (last nums)


import           Control.Monad
import           Data.IORef
import           Data.List.Split
import           Data.Maybe
import           Data.List

main :: IO ()
main = do
  [k, s] <- map read . words <$> getLine

  print $ length
    [ 0 | x <- [0 .. k], y <- [0 .. k], k >= s - (x + y) && 0 <= s - (x + y) ]


main :: IO ()
main = do
  [k,s] <- map read . words <$> getLine :: IO [Int]

  print $ length ['0'|x<-[(max 0 (s-2*k))..k],y<-[(max 0 (s-2*k))..(max 0 . min k $ (s-x))],x+y>=s-k]


main :: IO ()
main = do
    [k,s] <- map read . words <$> getLine
    print . length $ xyzs k s

xyzs :: Int -> Int -> [(Int, Int, Int)]
xyzs k s = [(x,y,z) | x <- [0..k], y <- [0..k], let z = s-(x+y), 0 <= z && z <= k]


main = map read . words <$> getLine >>= \[k, s] -> print (length [() | x <- [0..k], y <- [0..k], x+y<=s, s<=x+y+k])


main = do
	[k, s] <- map read . words <$> getLine
	print $ length [() | x <- [0..k], y <- [0..(k - x)], let z = s - x - y]


import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

solve :: Int -> Int -> Int -> Int -> Int -> Int
solve i j t k s
    | i > s || i > k = t
    | j - i > k || j > s = solve (i + 1) (i + 1) t k s
    | s - j > k = solve i (j + 1) t k s
    | otherwise = solve i (j + 1) (t + 1) k s

main :: IO ()
main = do
    [k, s] <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine :: IO [Int]
    print $ solve 0 0 0 k s


main :: IO ()
main = do
  [k, s] <- (map read . words) <$> getLine :: IO [Int]
  print $ length [1 | x <- [0..k], y <- [0..k], 0 <= s - x - y, s - x - y <= k]


import Control.Monad
import Control.Applicative
import Data.List
import Data.Array
strToInt s = (read :: String -> Int) s

main = do
    [k,s] <- (map strToInt . words) <$> getLine
    let sn = [(x,y,s-x-y) | x <- [0..k] , y <- [0..k] , s-x-y >= 0 , s-x-y <= k]
    print (length sn)


main = do
 [k,s] <- map read . words <$> getLine :: IO [Integer]
 print $ length [() | x<-[0..k], y<-[0..k], s-(x+y)<=k, s-(x+y)>=0]


main = do
  [k, s] <- map (read::String->Int) . words <$> getLine
  putStrLn $ show (length [s - x - y | x <- [0..k], y <- [0..k], s - x - y >= 0, s - x - y <= k])


import Control.Applicative

main :: IO ()
main = do
    [k, s] <- map read . words <$> getLine
    print $ sum [1 | x <- [0..k], y <- [0..k], let z = s - x - y, 0 <=  z, z <= k]


import Control.Applicative

main :: IO ()
main = do
    [k, s] <- map read . words <$> getLine
    print $ length [x + y + z | x <- [0..k], y <- [0..k], z <- [0..k], x + y + z == s]


import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Maybe
import qualified Data.ByteString.Char8 as BS
import           Debug.Trace

-- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + --

main :: IO ()
main = do
  (k, s) <- readInt2 <$> BS.getLine
  print $ f (k, s) k

f :: (Int, Int) -> Int -> Int
f (k, s) x
  |x < 0 || 2 * k < s' = 0
  |s' >= k  = (2 * k - s' + 1) + (f (k, s) (x - 1))
  |s' <  k  = s' + 1 + (f (k, s) (x - 1))
  |otherwise           = 0
  where
    s' = s - x

-- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + -- + --

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)


import Control.Applicative

main :: IO ()
main = do
  [k, s] <- (map read . words) <$> getLine
  print . length $ [(x,y,z)|x<-[0..k], y<-[0..k], z<-[0..k], x + y + z == s]


import Data.Char
import Data.List

solve :: Int -> Int -> Int
solve k s = solver 0 0
    where　solver x y
            | y > k = 0
            | x > k = 0
            | x == 0 = solver 0 (y+1) + solver 1 y + if (s-y)>=0 && (s-y) <= k then 1 else 0
            | otherwise = solver (x+1) y + if (s-x-y)>=0 && (s-x-y) <= k then 1 else 0

main = do
    [k,s] <- (map read . words) <$> getLine
    print $ solve k s


import Control.Applicative ((<$>), (<*>))
import Control.Monad
import Data.List

main :: IO ()
main = do
  solve <$> getl (map read . words) >>= print

solve :: [Int] -> Int
solve [k, s] = length $ [x| x <- [0..k], y <- [0..k], let z = s - x - y, z >= 0, z <= k]

getl :: (String -> a) -> IO a
getl f = f <$> getLine


import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Text.Printf
import Debug.Trace

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

solve x y k s a
  | x > k = a
  | y > k = solve (x+1) 0 k s a
  | otherwise = solve x (y+1) k s (a + (if 0 <= z && z <= k then 1 else 0))
  where z = s - x - y

main = do
  [k,s] <- getInts
  print $ solve 0 0 k s 0


{-# LANGUAGE OverloadedStrings #-}
import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe
import Data.String
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BS
---------------------------------------------------------------------------------
main = do
  s <- getLine'
  putStrLn' $ hakuchumu s

hakuchumu s
  | s=="" = "YES"
  | BS.isSuffixOf "dream" s = hakuchumu $ take' (length' s - 5) s
  | BS.isSuffixOf "dreamer" s = hakuchumu $ take' (length' s - 7) s
  | BS.isSuffixOf "erase" s = hakuchumu $ take' (length' s - 5) s
  | BS.isSuffixOf "eraser" s = hakuchumu $ take' (length' s - 6) s
  | otherwise = "NO"

---------------------------------------------------------------------------------

{-ByteString関連-}
--IO
getLine' = BS.getLine
getContents' = BS.getContents
getInt' = fst . fromJust . BS.readInt <$> getLine'
getIntListw' = map (fst . fromJust. BS.readInt) .words' <$> getContents'
getIntListl' = map (fst . fromJust. BS.readInt) .lines' <$> getContents'
getInteger' = fst . fromJust. BS.readInteger <$> getLine'
putStr' = BS.putStr
putStrLn' = BS.putStrLn
--演算子
bs1 |++| bs2 = BS.append bs1 bs2
chr |:+| bs2 = BS.cons chr bs2
bs1 |+:| chr = BS.snoc bs1 chr
--部分文字列操作
head' bs = BS.head bs
last' bs = BS.last bs
init' bs = BS.init bs
tail' bs = BS.tail bs
take' n bs = BS.take n bs
drop' n bs = BS.drop n bs
takeWhile' f bs = BS.takeWhile f bs
dropWhile' f bs = BS.dropWhile f bs
--リスト操作
length' bs = BS.length bs
reverse' bs = BS.reverse bs
transpose' bs = BS.transpose bs
sort' bs = BS.sort bs
group' bs = BS.group bs
lines' bs = BS.lines bs
words' bs = BS.words bs
unlines' bs = BS.unlines bs
unwords' bs = BS.unwords bs
--要素の有無
elem' chr bs = BS.elem chr bs
notElem' chr bs = BS.notElem chr bs
elemIndex' chr bs = BS.elemIndex chr bs
elemIndices' chr bs = BS.elemIndices chr bs
count' chr bs = BS.count chr bs
--整形
--justifyRight'::Char -> ByteString -> ByteString
--justifyRight' chr bs = convertString $ T.justifyRight chr (convertString bs)

{-elem関連-}
--elemの第一引数をリストにしたもの。
--elemList "abc" "atcoder" -> [True,False,True]
elemList [] _ = []
elemList (x:xs) list  = elem x list : elemList xs list

--elemIndexの第一引数をリストにしたもの。
elemIndexList [] list = []
elemIndexList (x:xs) list  = elemIndex x list : elemIndexList xs list

--elemIndicesの第一引数をリストにしたもの。
elemIndicesList [] list = []
elemIndicesList (x:xs) list  = elemIndices x list : elemIndicesList xs list

Score : 300 points

Problem Statement

You are given a string S consisting of lowercase English letters.
Another string T is initially empty.
Determine whether it is possible to obtain S = T by performing the following operation an arbitrary number of times:

Append one of the following at the end of T: dream, dreamer, erase and eraser.

Constraints

1≦|S|≦10^5

S consists of lowercase English letters.

Input

The input is given from Standard Input in the following format:

S

Output

If it is possible to obtain S = T, print YES. Otherwise, print NO.

Sample Input 1

erasedream

Sample Output 1

YES

Append erase and dream at the end of T in this order, to obtain S = T.

Sample Input 2

dreameraser

Sample Output 2

YES

Append dream and eraser at the end of T in this order, to obtain S = T.

Sample Input 3

dreamerer

Sample Output 3

NO


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, BinaryLiterals, CPP, DerivingStrategies  #-}
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, LambdaCase #-}
{-# LANGUAGE MagicHash, MultiParamTypeClasses, MultiWayIf           #-}
{-# LANGUAGE NumericUnderscores, OverloadedStrings, PatternSynonyms #-}
{-# LANGUAGE RankNTypes, RecordWildCards, ScopedTypeVariables       #-}
{-# LANGUAGE StandaloneDeriving, TupleSections, TypeApplications    #-}
{-# LANGUAGE TypeFamilies, TypeInType, UnboxedTuples, ViewPatterns  #-}

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.Reader
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Data.Bifunctor
import           Data.Bool
import qualified Data.ByteString                   as B
import qualified Data.ByteString.Builder           as B
import qualified Data.ByteString.Char8             as C
import qualified Data.ByteString.Internal          as B
import qualified Data.ByteString.Unsafe            as B
import           Data.Char
import qualified Data.Foldable                     as F
import           Data.Function
import           Data.Functor.Identity
import qualified Data.IntMap.Strict                as IM
import qualified Data.IntSet                       as IS
import qualified Data.List                         as L
import qualified Data.Map.Strict                   as M
import           Data.Monoid
import           Data.Ord
import           Data.Primitive
import           Data.Proxy
import           Data.Ratio
import           Data.Semigroup
import qualified Data.Set                          as S
import           Data.Tuple
import qualified Data.Vector                       as V
import qualified Data.Vector.Algorithms.Intro      as Intro
import qualified Data.Vector.Fusion.Stream.Monadic as MS
import qualified Data.Vector.Fusion.Bundle.Monadic as MB
import           Data.Vector.Fusion.Util
import qualified Data.Vector.Generic               as G
import qualified Data.Vector.Generic.Mutable       as GM
import qualified Data.Vector.Mutable               as VM
import qualified Data.Vector.Primitive             as P
import qualified Data.Vector.Primitive.Mutable     as PM
import qualified Data.Vector.Unboxed               as U
import qualified Data.Vector.Unboxed.Mutable       as UM
import           Debug.Trace
import           Foreign                           hiding (void)
import           GHC.Exts
import           GHC.TypeLits
import           System.IO
import           Unsafe.Coerce

#define MOD 1000000007

main :: IO ()
main = C.getLine >>= putStrLn.bool"NO""YES".solve

solve :: C.ByteString -> Bool
solve bs = maybe False (const True) $ runParser expr bs

expr :: Parser ()
expr =  dfs "dreamer" expr
    <|> dfs "dream"   expr
    <|> dfs "eraser"  expr
    <|> dfs "erase"   expr
    <|> end

dfs :: C.ByteString -> Parser () -> Parser ()
dfs k p = do
    bs <- get
    guard $ k `C.isPrefixOf` bs
    modify' (C.drop (C.length k))
    p <|> (modify' (B.unsafeDrop (-C.length k)) *> empty)

end :: Parser ()
end = do
    bs <- get
    guard $ C.null bs

-------------------------------------------------------------------------------
-- Utils
-------------------------------------------------------------------------------
rep :: (Monad m) => Int -> (Int -> m ()) -> m ()
rep n = flip MS.mapM_ (stream 0 n)
{-# INLINE rep #-}
rev :: (Monad m) => Int -> (Int -> m ()) -> m ()
rev !n = flip MS.mapM_ (streamR 0 n)
{-# INLINE rev #-}
stream :: (Monad m) => Int -> Int -> MS.Stream m Int
stream !l !r = MS.Stream step l where { step x | x < r = return $ MS.Yield x (x + 1) | otherwise = return MS.Done; {-# INLINE [0] step #-}}
{-# INLINE [1] stream #-}
streamR :: (Monad m) => Int -> Int -> MS.Stream m Int
streamR !l !r = MS.Stream step (r - 1) where { step x | x >= l = return $ MS.Yield x (x - 1) | otherwise = return MS.Done; {-# INLINE [0] step #-}}
{-# INLINE [1] streamR #-}
stream' :: (Monad m) => Int -> Int -> Int -> MS.Stream m Int
stream' !l !r !d = MS.Stream step l where { step x | x < r = return $ MS.Yield x (x + d) | otherwise = return MS.Done; {-# INLINE [0] step #-}}
{-# INLINE [1] stream' #-}
infixl 8 `shiftRL`, `unsafeShiftRL`
shiftRL :: Int -> Int -> Int
shiftRL = unsafeShiftRL
{-# INLINE shiftRL #-}
unsafeShiftRL :: Int -> Int -> Int
unsafeShiftRL (I# x#) (I# i#) = I# (uncheckedIShiftRL# x# i#)
{-# INLINE unsafeShiftRL #-}
type Parser a = StateT C.ByteString Maybe a
runParser :: Parser a -> C.ByteString -> Maybe (a, C.ByteString)
runParser = runStateT
{-# INLINE runParser #-}
int :: Parser Int
int = coerce $ C.readInt . C.dropWhile isSpace
{-# INLINE int #-}
int1 :: Parser Int
int1 = fmap (subtract 1) int
{-# INLINE int1 #-}
char :: Parser Char
char = coerce C.uncons
{-# INLINE char #-}
byte :: Parser Word8
byte = coerce B.uncons
{-# INLINE byte #-}
skipSpaces :: Parser ()
skipSpaces = modify' (C.dropWhile isSpace)
{-# INLINE skipSpaces #-}
lowerBoundM :: (Monad m) => Int -> Int -> (Int -> m Bool) -> m Int
lowerBoundM low high p = go low high where { go !low !high | high <= low = return high | otherwise = p mid >>= bool (go (mid + 1) high) (go low mid) where { mid = low + unsafeShiftRL (high - low) 1}}
{-# INLINE lowerBoundM #-}
upperBoundM :: (Monad m) => Int -> Int -> (Int -> m Bool) -> m Int
upperBoundM low high p = do { flg <- p high; if flg then return high else subtract 1 <$!> lowerBoundM low high (fmap not . p)}
{-# INLINE upperBoundM #-}
lowerBound :: Int -> Int -> (Int -> Bool) -> Int
lowerBound low high p = runIdentity (lowerBoundM low high (return . p))
{-# INLINE lowerBound #-}
upperBound :: Int -> Int -> (Int -> Bool) -> Int
upperBound low high p = runIdentity (upperBoundM low high (return . p))
{-# INLINE upperBound #-}


import Data.Bool
import Data.Char
import Data.List

main = interact $ bool "NO" "YES" . sol . filter isLower

sol s
  | null s                = True
  | ts!!0 `isSuffixOf` s  = sol (take (length s-5) s)
  | ts!!1 `isSuffixOf` s  = sol (take (length s-7) s)
  | ts!!2 `isSuffixOf` s  = sol (take (length s-5) s)
  | ts!!3 `isSuffixOf` s  = sol (take (length s-6) s)
  | otherwise             = False

ts = ["dream","dreamer","erase","eraser"]


import Data.List

prefixes = map reverse ["dream", "dreamer", "erase", "eraser"]
matcher s = filter (\x -> isPrefixOf x s) prefixes

matching "" = "YES"
matching str =
  let x = matcher str
  in if length x  > 0 then matching $ drop (length . head $ x) str else "NO"

main = getLine >>= putStrLn . matching . reverse


check :: String -> Bool
check "resare" = True
check "esare" = True
check "remaerd" = True
check "maerd" = True
check (c1:c2:c3:c4:c5:c6:c7:cs)
    | head5 == "resar" = if c6 == 'e'
                         then check (c7:cs)
                         else False
    | head5 == "esare" = check $ c6:c7:cs
    | head5 == "remae" = if (c6:c7:[] == "rd")
                         then (check cs)
                         else False
    | head5 == "maerd" = check $ c6:c7:cs
    | otherwise = False
    where head5 = c1:c2:c3:c4:c5:[]
check _ = False

main :: IO ()
main = do
    sentence <- getLine :: IO String
    putStr $ if (check $ reverse sentence) then "YES" else "NO"


import Control.Arrow ((&&&))
import Data.List (isPrefixOf, reverse)

isDream, isDreamer, isErase, isEraser :: String -> Bool
restOfDream, restOfDreamer, restOfErase, restOfEraser :: String -> String
[(isDream,   restOfDream),
 (isDreamer, restOfDreamer),
 (isErase,   restOfErase),
 (isEraser,  restOfEraser)] = map (isPrefixOf . reverse &&& drop . length) ["dream", "dreamer", "erase", "eraser"]

exist :: String -> Bool
exist [] = True
exist sna
  | isDream sna = exist $ restOfDream sna
  | isDreamer sna = exist $ restOfDreamer sna
  | isErase sna = exist $ restOfErase sna
  | isEraser sna = exist $ restOfEraser sna
  | otherwise = False

main :: IO ()
main = do
  ans <- getLine
  putStrLn $ if exist (reverse ans) then "YES" else "NO"


import Control.Arrow ((&&&))
import Data.List

isDream, isDreamer, isErase, isEraser :: String -> Bool
[(isDream, lenDream),
 (isDreamer, lenDreamer),
 (isErase, lenErase),
 (isEraser, lenEraser)] = map (isPrefixOf . reverse &&& length) ["dream", "dreamer", "erase", "eraser"]

exist :: String -> Bool
exist sna
  | null sna = True
  | isDream sna = exist $ drop lenDream sna
  | isDreamer sna = exist $ drop lenDreamer sna
  | isErase sna = exist $ drop lenErase sna
  | isEraser sna = exist $ drop lenEraser sna
  | otherwise = False

main :: IO ()
main = do
  ans <- getLine
  putStrLn $ if exist (reverse ans) then "YES" else "NO"


import Control.Monad
import Data.Maybe (fromJust)
import Data.List
import Data.Char

isDayDream :: String -> Bool
isDayDream "" = True
isDayDream s
    | (isPrefixOf "maerd" s) = isDayDream (drop 5 s)
    | (isPrefixOf "remaerd" s) = isDayDream (drop 7 s)
    | (isPrefixOf "esare" s) = isDayDream (drop 5 s)
    | (isPrefixOf "resare" s) = isDayDream (drop 6 s)
    | otherwise =  False

toYesNo :: Bool -> String
toYesNo True = "YES"
toYesNo _ = "NO"

solve :: String -> String
solve = toYesNo . isDayDream . reverse

main :: IO ()
main = do
    s <- getLine
    putStrLn $ solve s


import Control.Monad
import Data.Maybe (fromJust)
import Data.List
import Data.Char
import Debug.Trace

isDayDream :: String -> Bool
isDayDream "" = True
isDayDream s
    | (isPrefixOf "maerd" s) = isDayDream (drop 5 s)
    | (isPrefixOf "remeard" s) = isDayDream (drop 7 s)
    | (isPrefixOf "esare" s) = isDayDream (drop 5 s)
    | (isPrefixOf "resare" s) = isDayDream (drop 6 s)
    | otherwise =  trace s False

toYesNo :: Bool -> String
toYesNo True = "YES"
toYesNo _ = "NO"

solve :: String -> String
solve = toYesNo . isDayDream . reverse

main :: IO ()
main = do
    s <- getLine
    putStrLn $ solve s


main = do
    s <- getLine
    putStrLn $ if analyze (reverse s) then "YES" else "NO"

analyze "" = True
analyze ('m':'a':'e':'r':'d':k) = analyze k
analyze ('r':'e':'m':'a':'e':'r':'d':k) = analyze k
analyze ('e':'s':'a':'r':'e':k) = analyze k
analyze ('r':'e':'s':'a':'r':'e':k) = analyze k
analyze _ = False


import Data.List

main :: IO ()
main = do
    x <- getLine
    putStrLn (hantei "" x)

-- ここは他に回そうif as == bs then
hantei :: String -> String -> String
hantei as bs = if as == bs then "Yes"
    else if isSuffixOf ("eraser" ++ as) bs then hantei ("eraser" ++ as) bs
    else if isSuffixOf ("erase" ++ as) bs then hantei ("erase" ++ as) bs
    else if isSuffixOf ("dreamer" ++ as) bs then hantei ("dreamer" ++ as) bs
    else if isSuffixOf ("dream"  ++ as) bs then hantei ("dream"  ++ as) bs
    else "No"


import Data.List

main :: IO ()
main = do
    x <- fmap reverse getLine
    putStrLn (hantei "" x)

-- ここは他に回そうif as == bs then
hantei :: String -> String -> String
hantei as bs =  if as == bs then "Yes"
                else if isPrefixOf (as ++ "maerd") bs then hantei (as ++ "maerd") bs
                else if isPrefixOf (as ++ "remaerd") bs then hantei (as ++ "remaerd") bs
                else if isPrefixOf (as ++ "esare") bs then hantei (as++ "esare") bs
                else if isPrefixOf (as ++ "resare") bs then hantei (as ++ "resare") bs
                else "No"


import Data.List

main :: IO ()
main = do
    x <- fmap reverse getLine
    putStrLn (hantei "" x)

-- ここは他に回そうif as == bs then
hantei :: String -> String -> String
hantei as bs =  if as == bs then "Yes"
                else if isPrefixOf (as ++ "maerd") bs then hantei (as ++ "maerd") bs
                else if isPrefixOf (as ++ "remeard") bs then hantei (as ++ "remaerd") bs
                else if isPrefixOf (as ++ "esare") bs then hantei (as++ "esare") bs
                else if isPrefixOf (as ++ "resare") bs then hantei (as ++ "resare") bs
                else "No"


import Control.Monad.State
import Control.Arrow
import Data.Maybe
import Data.List

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

dayDream [] = Just ()
dayDream ('m':'a':'e':'r':'d':a) = dayDream a
dayDream ('r':'e':'m':'a':'e':'r':'d':a) = dayDream a
dayDream ('r':'e':'s':'a':'r':'e':a) = dayDream a
dayDream ('e':'s':'a':'r':'e':a) = dayDream a
dayDream _ = Nothing

main = do
    str <- reverse <$> getLine
    if isJust $ dayDream str then putStrLn "YES" else putStrLn "NO"
-- main = undefined


import Data.List

main = do
  s <- getLine
  putStrLn . showF $ f s

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

f :: String -> Bool
f [] = True
f s
  | "dream" `isPrefixOf` s && "dreamer" `isPrefixOf` s = f (drop 5 s) || f (drop 7 s)
  | "dream" `isPrefixOf` s = f (drop 5 s)
  | "dreamer" `isPrefixOf` s = f (drop 7 s)
  | "erase" `isPrefixOf` s && "eraser" `isPrefixOf` s = f (drop 5 s) || f (drop 6 s)
  | "erase" `isPrefixOf` s = f (drop 5 s)
  | "eraser" `isPrefixOf` s = f (drop 6 s)
  | otherwise = False


import Data.List
import Control.Monad
import Control.Applicative

solver :: String  -> String
solver s
    | null s = "Yes"
    | isPrefixOf "remaerd" s = solver $ drop 7 s
    | isPrefixOf "maerd"   s = solver $ drop 5 s
    | isPrefixOf "resare"  s = solver $ drop 6 s
    | isPrefixOf "esare"   s = solver $ drop 5 s
    | otherwise      = "No"

main :: IO ()
main = getLine >>= (putStrLn . solver . reverse)


import Data.List
import Control.Monad
import Control.Applicative

data YesNo = Yes | No deriving(Show)

solver :: String  -> YesNo
solver s
    | null s = Yes
    | isPrefixOf "remaerd" s = solver $ drop 7 s
    | isPrefixOf "maerd"   s = solver $ drop 5 s
    | isPrefixOf "resare"  s = solver $ drop 6 s
    | isPrefixOf "esare"   s = solver $ drop 5 s
    | otherwise      = No

main :: IO ()
main = getLine >>= (print . solver . reverse)


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

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

parse :: String -> Maybe String
parse "" = Just ""
parse s = let
    a = if take (length "dream")   s == "dream"   then Just $ drop (length "dream")   s else Nothing
    b = if take (length "dreamer") s == "dreamer" then Just $ drop (length "dreamer") s else Nothing
    c = if take (length "erase")   s == "erase"   then Just $ drop (length "erase")   s else Nothing
    d = if take (length "eraser")  s == "eraser"  then Just $ drop (length "eraser")  s else Nothing
    in (parse =<< a) <|> (parse =<< b) <|> (parse =<< c) <|> (parse =<< d)


import qualified Data.ByteString.Char8 as BC

main = do
  s <- BC.unpack . BC.reverse <$> BC.getLine
  if solve s then putStrLn "YES"
             else putStrLn "NO"

solve :: String -> Bool
solve s
  | length s >= 7 && (take 7 s) == "remaerd" = solve $ drop 7 s
  | length s >= 6 && (take 6 s) == "resare" = solve $ drop 6 s
  | length s >= 5 && (take 5 s) == "maerd" = solve $ drop 5 s
  | length s >= 5 && (take 5 s) == "esare" = solve $ drop 5 s
  | otherwise = length s == 0


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

main :: IO ()
main = putStrLn =<< solve <$> getLine

solve :: String -> String
solve s
    | solve' s  = "YES"
    | otherwise = "NO"

solve' :: String -> Bool
solve' "" = True
solve' s = any (match s) ts where
    ts = ["dreameraser", "dreamerase", "dreamer",
          "dream", "eraser", "erase"]

match :: String -> String -> Bool
match s t
    | take n s == t = solve' $ drop n s
    | otherwise     = False where
          n = length t


import Data.List

test [] = "YES"
test str@('m':sx) = if isPrefixOf "maerd" str
                    then test $ drop 5 str
                    else "NO"
test str@('r':sx) = if isPrefixOf "remaerd" str
                    then test $ drop 7 str
                    else if isPrefixOf "resare" str
                         then test $ drop 6 str
                         else "NO"
test str@('e':sx) = if isPrefixOf "esare" str
                    then test $ drop 5 str
                    else "NO"
test _ = "NO"

main = do
  l <- getLine
  let o = test $ reverse l
  putStrLn o


{-# LANGUAGE BangPatterns #-}
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: String -> Int -> String
solve ('d':'r':'e':'a':'m':other) _ = solve other 1
solve ('e':'r':'a':'s':'e':other) _ = solve other 2
solve ('e':'r':'d':'r':'e':'a':'m':other) 1 = solve other 1
solve "er" 1 = "YES"
solve "r" 2 = "YES"
solve [] _ = "YES"
solve _ _ = "NO"

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


import Data.Bool
import Data.List

main = getLine >>= putStrLn . bool "NO" "YES" . dd . Just . reverse

dd Nothing = False
dd (Just "") = True
dd (Just s@('m':_)) = dd (stripPrefix "maerd" s)
dd (Just s@('r':'e':'m':_)) = dd (stripPrefix "remaerd" s)
dd (Just s@('e':_)) = dd (stripPrefix "esare" s)
dd (Just s@('r':'e':'s':_)) = dd (stripPrefix "resare" s)
dd _ = False


--{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE ScopedTypeVariables #-}
--{-# LANGUAGE FlexibleContexts #-}
--{-# LANGUAGE ViewPatterns #-}
--{-# LANGUAGE OverloadedStrings #-}
--{-# LANGUAGE Strict #-}
--{-# LANGUAGE NumericUnderscores #-}
--{-# LANGUAGE BlockArguments #-}
--{-# LANGUAGE MultiWayIf #-}

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as MP
import qualified Data.Map.Strict as MPS
import qualified Data.Set as ST
import qualified Data.Sequence as SQ
-- import Data.Array
import Data.Array.Unboxed
-- import Data.Array.ST
-- import Data.Array.IO
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Char
import Data.Bits
import Data.List
import Data.Tuple
import Data.Functor
import Data.IORef
import Data.STRef
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
-- import qualified Data.Vector.Algorithms.Merge as VAM
-- import qualified Data.Heap as HP
-- import Numeric.Extra
-- import Data.Tuple.Extra
-- import Data.List.Extra

--------------------------------------------------------------------------
main = do
    xs <- strBS
    print $ length $ [() | i<-[0..BC.length xs - 2], (BC.index xs i) /= (BC.index xs (i+1))]
--------------------------------------------------------------------------

-- Input Util
int :: IO Int
int = BC.getLine >>= return . bsToInt

double :: IO Double
double = BC.getLine >>= return . bsToDouble

str :: IO String
str = BC.getLine >>= return . BC.unpack

strBS :: IO BC.ByteString
strBS = BC.getLine

-- convert
bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

bsToDouble :: BC.ByteString -> Double
bsToDouble = read . BC.unpack

bsToIntTuple :: BC.ByteString -> (Int, Int)
bsToIntTuple bs = (a,b)
    where
        Just (a,bs') = parseInt bs
        Just (b,_) = parseInt bs'

bsToIntTriple :: BC.ByteString -> (Int, Int, Int)
bsToIntTriple bs = (a,b,c)
    where
        Just (a,bs') = parseInt bs
        Just (b,bs'') = parseInt bs'
        Just (c,_) = parseInt bs''

parseInt :: BC.ByteString -> Maybe (Int, BC.ByteString)
parseInt = BC.readInt . BC.dropWhile isSpace

-- single line
fromSLineL :: (BC.ByteString -> a) -> IO [a]
fromSLineL f = strBS >>= return . map f . BC.words

-- from single line to List / VU.Vector
sLineToIntL :: IO [Int]
sLineToIntL = fromSLineL bsToInt

sLineToDoubleL :: IO [Double]
sLineToDoubleL = fromSLineL bsToDouble

sLineToStrL :: IO [String]
sLineToStrL = fromSLineL BC.unpack

sLineToStrBSL :: IO [BC.ByteString]
sLineToStrBSL = fromSLineL id

sLineToIntV :: Int -> IO (VU.Vector Int)
sLineToIntV n = BC.getLine >>= return . VU.unfoldrN n parseInt

sLineToDoubleV :: IO (VU.Vector Double)
sLineToDoubleV = BC.getLine >>= return . VU.fromList . map bsToDouble . BC.words

-- multiple lines
fromMLinesL :: Int -> (BC.ByteString -> a) -> IO [a]
fromMLinesL n f = replicateM n (strBS >>= return . f)

fromMLinesV :: VU.Unbox a => Int -> (BC.ByteString -> a) -> IO (VU.Vector a)
fromMLinesV n f = VU.replicateM n (strBS >>= return . f)

-- from multiple lines to List / VU.Vector
mLinesToIntL :: Int -> IO [Int]
mLinesToIntL n = fromMLinesL n bsToInt

mLinesToDoubleL :: Int -> IO [Double]
mLinesToDoubleL n = fromMLinesL n bsToDouble

mLinesToStrL :: Int -> IO [String]
mLinesToStrL n = fromMLinesL n BC.unpack

mLinesToStrBSL :: Int -> IO [BC.ByteString]
mLinesToStrBSL n = fromMLinesL n id

mLinesToTupleL :: Int -> IO [(Int, Int)]
mLinesToTupleL n = fromMLinesL n bsToIntTuple

mLinesToTripleL :: Int -> IO [(Int, Int, Int)]
mLinesToTripleL n = fromMLinesL n bsToIntTriple

mLinesToIntV :: Int -> IO (VU.Vector Int)
mLinesToIntV n = fromMLinesV n bsToInt

mLinesToDoubleV :: Int -> IO (VU.Vector Double)
mLinesToDoubleV n = fromMLinesV n bsToDouble

mLinesToTupleV :: Int -> IO (VU.Vector (Int, Int))
mLinesToTupleV n = fromMLinesV n bsToIntTuple

mLinesToTripleV :: Int -> IO (VU.Vector (Int, Int, Int))
mLinesToTripleV n = fromMLinesV n bsToIntTriple

-- output
yesnoL :: Bool -> IO ()
yesnoL cond
    | cond = putStrLn "Yes"
    | otherwise = putStrLn "No"

yesnoU :: Bool -> IO ()
yesnoU cond
    | cond = putStrLn "YES"
    | otherwise = putStrLn "NO"

-- others
strToChr :: String -> Char
strToChr [x] = x

chrToStr :: Char -> String
chrToStr x = [x]

m1 :: Int -> Int
m1 x = subtract 1 x

toDouble :: Int -> Double
toDouble x = fromIntegral x

toInt :: Double -> Int
toInt x = floor x

sqToList :: SQ.Seq a -> [a]
sqToList sq =
    case SQ.viewl sq of
        SQ.EmptyL -> []
        x SQ.:< sq' -> x : sqToList sq'

Score : 300 points

Problem Statement

Two foxes Jiro and Saburo are playing a game called 1D Reversi. This game is played on a board, using black and white stones. On the board, stones are placed in a row, and each player places a new stone to either end of the row. Similarly to the original game of Reversi, when a white stone is placed, all black stones between the new white stone and another white stone, turn into white stones, and vice versa.

In the middle of a game, something came up and Saburo has to leave the game. The state of the board at this point is described by a string S. There are |S| (the length of S) stones on the board, and each character in S represents the color of the i-th (1 ≦ i ≦ |S|) stone from the left. If the i-th character in S is B, it means that the color of the corresponding stone on the board is black. Similarly, if the i-th character in S is W, it means that the color of the corresponding stone is white.

Jiro wants all stones on the board to be of the same color. For this purpose, he will place new stones on the board according to the rules. Find the minimum number of new stones that he needs to place.

Constraints

1 ≦ |S| ≦ 10^5

Each character in S is B or W.

Input

The input is given from Standard Input in the following format:

S

Output

Print the minimum number of new stones that Jiro needs to place for his purpose.

Sample Input 1

BBBWW

Sample Output 1

1

By placing a new black stone to the right end of the row of stones, all white stones will become black. Also, by placing a new white stone to the left end of the row of stones, all black stones will become white.

In either way, Jiro's purpose can be achieved by placing one stone.

Sample Input 2

WWWWWW

Sample Output 2

0

If all stones are already of the same color, no new stone is necessary.

Sample Input 3

WBWBWBWBWB

Sample Output 3

9


import Data.List

main = interact $ show . pred . length . group


main = do
  s <- getLine
  print $ (length $ dist s "") - 1

dist :: String ->  String -> [String]
dist [] ys = [ys]
dist (x:xs) [] = dist xs [x]
dist (x:xs) (y:ys)
  | x == y = dist xs (x:y:ys)
  | otherwise = (y:ys) : dist xs [x]


import Control.Monad
import Data.Maybe (fromJust)
import Data.List as List

solve :: String -> Int
solve [] = 0
solve (x:[]) = 0
solve (x1:x2:xs)
    | x1 /= x2 = 1 + (solve (x2:xs))
    | otherwise = (solve (x2:xs))

main :: IO()
main = do
    c <- getLine
    print $ solve c


import Data.List

main :: IO()
main = do
    str <- getLine
    print $ (length (group str)) - 1


import Data.List
main :: IO ()
main = getLine >>= \s -> print $ length (group s) - 1


import Data.List
main = print . (subtract 1) . length . nub =<< getLine


import Data.List
main = do
  l <- getLine
  putStrLn $ show $ (length $ groupBy (==) l) - 1


import Data.List

main :: IO ()
main = do
  line <- getLine
  print $ length $ tail $ group line


import Data.List

solve xs = (length $ group xs) - 1

main = print . solve =<< getLine


main::IO()
main =do
  d<-getLine
  print (solver (trans d))

trans::String -> [Bool]
trans cs = map (\x-> if x=='B' then True else False) cs

solver :: [Bool]->Int
solver     []   =0
solver (_:[])   =0
solver (x:y:dat)=if x==y then solver (y:dat) else 1+(solver (y:dat))


import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe

main = putStrLn .concat .sort .tail .lines =<< getContents

Score : 200 points

Problem Statement

Iroha has a sequence of N strings S_1, S_2, ..., S_N. The length of each string is L.

She will concatenate all of the strings in some order, to produce a long string.

Among all strings that she can produce in this way, find the lexicographically smallest one.

Here, a string s=s_1s_2s_3...s_n is lexicographically smaller than another string t=t_1t_2t_3...t_m if and only if one of the following holds:

There exists an index i(1≦i≦min(n,m)), such that s_j = t_j for all indices j(1≦j<i), and s_i<t_i.

s_i = t_i for all integers i(1≦i≦min(n,m)), and n<m.

Constraints

1 ≦ N, L ≦ 100

For each i, the length of S_i equals L.

For each i, S_i consists of lowercase letters.

Input

The input is given from Standard Input in the following format:

N L
S_1
S_2
:
S_N

Output

Print the lexicographically smallest string that Iroha can produce.

Sample Input 1

3 3
dxx
axx
cxx

Sample Output 1

axxcxxdxx

The following order should be used: axx, cxx, dxx.


module Main where

import           Control.Monad
import           Debug.Trace
import qualified Data.Vector.Unboxed           as VU
import           Data.List
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Char8         as BSC8
import           Data.Char
import           Data.Maybe

tuplify2 (x : y : _) = (x, y)
tuplify2 _           = undefined

getVUIntFromInputLineAtBSC8 :: IO (VU.Vector Int)
getVUIntFromInputLineAtBSC8 =
    VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine
getVUIntListFromInputLineAtBSC8 =
    VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

readInt = fst . fromJust . BSC8.readInt
readIntTuple = tuplify2 . map readInt . BSC8.words
readIntList = map readInt . BSC8.words

getInt = readInt <$> BSC8.getLine
getIntList = readIntList <$> BSC8.getLine
getIntNList n = map readIntList <$> replicateM (fromIntegral n) BSC8.getLine
getIntMatrix = map readIntList . BSC8.lines <$> BS.getContents
getIntTuple = readIntTuple <$> BSC8.getLine
getIntNTuples n = map readIntTuple <$> replicateM (fromIntegral n) BSC8.getLine
getIntTuples = map readIntTuple . BSC8.lines <$> BSC8.getContents

main :: IO ()
main = do
    [aN,aL] <- getIntList
    aS <- foldl (\acc x -> do
        aS <- getLine
        accString <- acc
        return (accString ++ [aS])) (return []) [1..aN]
    let ret = foldl (\acc x->acc ++ x) [] (sort aS)
    putStrLn ret


import Data.List
import Control.Monad

main = do
  [n, l] <- map read . words <$>	getLine
  lines <- replicateM n getLine
  putStrLn $ intercalate "" $ sort lines


import Data.Char
import Data.List

main = interact $ concat . sort . fmap (filter isLetter) . tail . lines


import Control.Monad
import Data.List

main :: IO ()
main = do
  [l, n] <- map read . words <$> getLine
  ss <- concat . sort <$> replicateM n getLine
  putStrLn ss


import Data.List (sort,foldl')

main = do
  _ <- getLine
  contents <- getContents
  let
    ans = foldl' (++) [] (sort $ lines contents)
  putStrLn ans


-- ABC042 B - 文字列大好きいろはちゃんイージー / Iroha Loves Strings (ABC Edition)

import Data.List
import Control.Monad

main ::IO()
main = do
    [n,len] <- map read . words <$> getLine
    sls <- replicateM n getLine
    putStrLn $ ketugou $ sort sls

ketugou :: [String] -> String
ketugou [] = ""
ketugou strls = head strls ++ ketugou (tail strls)


import Data.List
ac [] = ""
ac (x:xs) = x++ac xs
main=do
 getLine
 s<-sort.lines<$>getContents
 putStrLn$ac s


import Data.List
ac [] = ""
ac (x:xs) = "x"++ac xs
main=do
 getLine
 s<-sort.lines<$>getContents
 putStrLn$ac s


import qualified Data.ByteString.Char8 as C
import Data.Maybe ( fromJust )
import Control.Monad ( replicateM )
import qualified Data.List as L ( sort )

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

main :: IO ()
main = do
  [n,_] <- getParm
  ss    <- replicateM n C.getLine
  C.putStrLn $ minimumCombination ss

minimumCombination
 :: [C.ByteString] -> C.ByteString
minimumCombination = C.concat . L.sort


import Control.Monad
import Data.List

main = do
    [n, _] <- map read . words <$> getLine
    ss <- replicateM n getLine
    putStrLn . concat . sort $ ss


import Control.Monad
import Data.List
main :: IO ()
main = do
  [n,_] <- map read . words <$> getLine :: IO [Int]
  ss <- replicateM n getLine
  putStrLn $ concat . sort $ ss


import Data.List
main = do
  getLine
  putStrLn =<< concat . sort . lines <$> getContents


import Data.List
main = putStrLn . concat . sort . drop 1 . lines =<< getContents


{-# LANGUAGE OverloadedStrings #-}

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

main = breads >>= flip replicateM B.getLine . head >>= mapM_ B.putStr . sort >> B.putStrLn ""

breads :: IO [Int]
breads = unfoldr uff <$> B.getLine
    where
        uff b = check <$> B.readInt b
        check (a, b)
            | B.null b = (a, b)
            | otherwise = (a, B.tail b)


import Control.Monad
import Data.List

main = putStrLn . solve =<< parse

solve :: [String] -> String
solve = concat . sort

parse :: IO [String]
parse = do
    [n, l] <- map read . words <$> getLine
    replicateM n getLine


{-# LANGUAGE OverloadedStrings #-}
module Main where

import Prelude hiding (putStrLn, getLine, getContents)
import Data.List as L
import Data.Text as T
import Data.Text.IO

main :: IO ()
main = do
--    ln <- (read .unpack . L.head . (splitOn " ")) <$> getLine
    getLine
    ls <- T.lines <$> getContents
    putStrLn $ T.concat $ sort ls


import Control.Applicative
import Data.List

main :: IO ()
main = do
    [n,l] <- map read . words <$> getLine
    strings <- mapM (\_ -> getLine) [1..n]
    putStrLn . concat . sort $ strings


import Data.List
main = getContents >>=  putStrLn . concat . sort . tail . lines