Facetook is a well known social network website, and it will launch a new feature called Facetook Priority Wall. This feature will sort all posts from your friends according to the priority factor (it will be described).This priority factor will be affected by three types of actions:   1. "X posted on Y's wall" (15 points),  2. "X commented on Y's post" (10 points),  3. "X likes Y's post" (5 points). X and Y will be two distinct names. And each action will increase the priority factor between X and Y (and vice versa) by the above value of points (the priority factor between X and Y is the same as the priority factor between Y and X).You will be given n actions with the above format (without the action number and the number of points), and you have to print all the distinct names in these actions sorted according to the priority factor with you.

The first line contains your name. The second line contains an integer n, which is the number of actions (1 ≤ n ≤ 100). Then n lines follow, it is guaranteed that each one contains exactly 1 action in the format given above. There is exactly one space between each two words in a line, and there are no extra spaces. All the letters are lowercase. All names in the input will consist of at least 1 letter and at most 10 small Latin letters.

Print m lines, where m is the number of distinct names in the input (excluding yourself). Each line should contain just 1 name. The names should be sorted according to the priority factor with you in the descending order (the highest priority factor should come first). If two or more names have the same priority factor, print them in the alphabetical (lexicographical) order. Note, that you should output all the names that are present in the input data (excluding yourself), even if that person has a zero priority factor. The lexicographical comparison is performed by the standard "<" operator in modern programming languages. The line a is lexicographically smaller than the line b, if either a is the prefix of b, or if exists such an i (1 ≤ i ≤ min(|a|, |b|)), that ai < bi, and for any j (1 ≤ j < i) aj = bj, where |a| and |b| stand for the lengths of strings a and b correspondently.

ahmed
3
ahmed posted on fatma's wall
fatma commented on ahmed's post
mona likes ahmed's post

import Data.List
import Data.Monoid
import Data.Ord

solve myName lines =
		map snd $ sortBy compare costs
	where
		cost "posted" = 15
		cost "commented" = 10
		cost "likes" = 5

		fixName2 = takeWhile (/= '\'')
		parse [name1, action, _, name2', _] = (name1, cost action, fixName2 name2')
		parse [name1, action, name2', _] = (name1, cost action, fixName2 name2')

		lines' = map (parse . words) lines

		names = (nub $ map (\(name1, _, _) -> name1) lines' ++ map (\(_, _, name2) ->  name2) lines')
			\\ [myName]

		lines'' = filter (\(name1, _, name2) -> name1 == myName || name2 == myName) lines'

		items = map (\(name1, cost, _) -> (name1, cost)) lines'' ++
			map (\(_, cost, name2) -> (name2, cost)) lines''

		costs = [(s, name) | name <- names, let s = sum $ [snd i | i <- items, fst i == name]]

		compare =  flip (comparing fst) `mappend` comparing snd

main = do
	myName <- getLine
	_ <- getLine
	actions <- lines `fmap` getContents
	putStrLn $ unlines $ solve myName actions

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

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

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

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

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = map read . words <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

parseLine yourname line
  | ws !! 1 == "posted"     = get (ws !! 0) (name (ws !! 3)) 15
  | ws !! 1 == "commented"  = get (ws !! 0) (name (ws !! 3)) 10
  | ws !! 1 == "likes"      = get (ws !! 0) (name (ws !! 2)) 5
  where ws = words line
        get a b s
          | a == yourname = [(b, s)]
          | b == yourname = [(a, s)]
          | otherwise     = [(a, 0), (b, 0)]
        name s = take (length s - 2) s

main = do
  yourname <- getLine
  nLines <- int
  s <- replicateM nLines getLine
  let scores = concatMap (parseLine yourname) s
      resultMap = foldl' (flip (uncurry (M.insertWith' (+)))) M.empty scores
      resultAss = sortBy c (M.assocs resultMap)
      c (a, b) (c, d)
        | b > d = LT
        | b < d = GT
        | a < c = LT
        | a > c = GT
        | otherwise = EQ
      result = map fst resultAss
  mapM_ putStrLn result

import Control.Applicative
import Control.Monad
import Data.List
import Data.Function
import qualified Data.Map as M
import Data.Maybe

parseLine :: String -> (String, String, Int)
parseLine line = (head sp, init $ init target, score)
  where
    sp = words line
    target = head $ filter (elem '\'') sp
    score = case head (sp !! 1) of
        'p' -> 15
        'c' -> 10
        'l' -> 5

type MyMap = M.Map String Int

solve :: String -> [(String, String, Int)] -> [String]
solve myName pairs = filter (/=myName) . map fst . reverse . sortBy (compare `on` snd) . reverse .  sortBy (compare `on` fst) $ M.assocs mp
  where
    incr :: MyMap -> (String, String, Int) -> MyMap
    incr mp (f,r,s) = mp2
      where
        mp1 = M.insertWith' (+) f (if r == myName then s else 0) mp
        mp2 = M.insertWith' (+) r (if f == myName then s else 0) mp1
    mp = foldl incr M.empty pairs

main = do
    myName <- getLine
    n <- read <$> getLine :: IO Int
    pairs <- replicateM n (parseLine <$> getLine)
    let sorted = solve myName pairs
    mapM_ putStrLn sorted

import Control.Monad
import Data.List

split = rec [] []
  where
    rec res cur [] = reverse $ reverse cur:res
    rec res [] (' ':s) = rec res [] s
    rec res cur (' ':s) = rec (reverse cur:res) [] s
    rec res cur (s:ss) = rec res (s:cur) ss

process = do
  expr <- getLine
  return $ case split $ map (\c -> if c == '\'' then ' ' else c) expr of
    [n1, "posted", "on", n2, "s", "wall"] -> (n1, n2, 15)
    [n1, "commented", "on", n2, "s", "post"] -> (n1, n2, 10)
    [n1, "likes", n2, "s", "post"] -> (n1, n2, 5)

main = do
  you <- getLine
  n <- fmap read getLine :: IO Int
  acts <- replicateM n process :: IO [(String, String, Int)]
  mapM_ (putStrLn . fst) $ sortBy cmp $
    foldr (\(n1, n2, p) ls ->
            if you == n1
            then incr n2 p $ ls
            else if you == n2
                 then incr n1 p $ ls
                 else incr n2 0 $ incr n1 0 $ ls
          ) [] acts
  where
    (n1, p1) `cmp` (n2, p2) = (-p1, n1) `compare` (-p2, n2)
    incr :: String -> Int -> [(String, Int)] -> [(String, Int)]
    incr n p l =
      case lookup n l of
        Nothing -> (n, p) : l
        _ -> map (\(n', p') -> if n == n' then (n, p + p') else (n', p')) l
    swap (a, b) = (b, a)

import qualified Data.Map as M
import Control.Monad
import Data.List
import Data.Monoid
main = do
    name <- getLine
    n <- read `fmap` getLine :: IO Int
    let y = takeWhile (/= '\'')
        add m x ys n = let xy = [x, y ys] in if name `elem` xy then
                M.insertWith (+) (head $ delete name xy) n m
                else M.insertWith (+) x 0 $ M.insertWith (+) (last xy) 0 m
    a <- foldM (\m _ -> do
        l <- getLine
        return $ case words l of
            [x, "posted", _, ys, "wall"] -> add m x ys 15
            [x, "commented", _, ys, "post"] -> add m x ys 10
            [x, "likes", ys, "post"] -> add m x ys 5) M.empty [1..n]
    forM (sortBy (\(a1, a2) (b1, b2) -> compare b2 a2 `mappend` compare a1 b1) $
            M.toList a) (putStrLn . fst)

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

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

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

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

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = map read . words <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

parseLine yourname line
  | ws !! 1 == "posted"     = get (ws !! 0) (name (ws !! 3)) 15
  | ws !! 1 == "commented"  = get (ws !! 0) (name (ws !! 3)) 10
  | ws !! 1 == "likes"      = get (ws !! 0) (name (ws !! 2)) 5
  where ws = words line
        get a b s
          | a == yourname = [(b, s)]
          | b == yourname = [(a, s)]
          | otherwise     = [(a, 0), (b, 0)]
        name s = take (length s - 2) s

main = do
  yourname <- getLine
  nLines <- int
  s <- replicateM nLines getLine
  let scores = concatMap (parseLine yourname) s
      resultMap = foldl' (flip (uncurry (M.insertWith' (+)))) M.empty scores
      resultAss = sortBy c (M.assocs resultMap)
      c (a, b) (c, d)
        | a < c = LT
        | a > c = GT
        | b > d = LT
        | b < d = GT
        | otherwise = EQ
      result = map fst resultAss
  mapM_ putStrLn result


In one one-dimensional world there are n platforms. Platform with index k (platforms are numbered from 1) is a segment with coordinates [(k - 1)m, (k - 1)m + l], and l < m. Grasshopper Bob starts to jump along the platforms from point 0, with each jump he moves exactly d units right. Find out the coordinate of the point, where Bob will fall down. The grasshopper falls down, if he finds himself not on the platform, but if he finds himself on the edge of the platform, he doesn't fall down.

The first input line contains 4 integer numbers n, d, m, l (1 ≤ n, d, m, l ≤ 106, l < m) — respectively: amount of platforms, length of the grasshopper Bob's jump, and numbers m and l needed to find coordinates of the k-th platform: [(k - 1)m, (k - 1)m + l].

Output the coordinates of the point, where the grosshopper will fall down. Don't forget that if Bob finds himself on the platform edge, he doesn't fall down.

import Data.Int

inf :: Int64
inf = 1000000000000000

gap :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
gap d m l cur
	| cur > d * m		= inf
	| (mod cur m) > l	= cur
	| otherwise			= gap d m l (cur + d)

runout :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
runout n d m l = end + d - mod (end + d) d
	where end = (n - 1) * m + l

main :: IO()
main = do
	str <- getLine
	let input = map read (words str)
	let n = input !! 0
	let d = input !! 1
	let m = input !! 2
	let l = input !! 3
	putStrLn (show (min (gap d m l 0) (runout n d m l)))

jump x n d m l
        | zone >= n = x
        | x `mod` m > l = x
        | otherwise = jump (x + needs * d) n d m l
        where zone = x `div` m
              end = m * zone + l
              needs = (end - x) `div` d + 1

main = do
    line <- getLine
    let [n, d, m, l] = map read $ words $ line :: [Integer]
    putStrLn $ show $ jump 0 n d m l

jump x n d m l
        | zone >= n = x
        | x `mod` m > l = x
        | otherwise = jump (x + needs * d) n d m l
        where zone = x `div` m
              end = m * zone + l
              needs = (end - x) `div` d + 1

main = do
    line <- getLine
    let [n, d, m, l] = map read $ words $ line :: [Int]
    putStrLn $ show $ jump 0 n d m l


A film festival is coming up in the city N. The festival will last for exactly n days and each day will have a premiere of exactly one film. Each film has a genre — an integer from 1 to k.On the i-th day the festival will show a movie of genre ai. We know that a movie of each of k genres occurs in the festival programme at least once. In other words, each integer from 1 to k occurs in the sequence a1, a2, ..., an at least once.Valentine is a movie critic. He wants to watch some movies of the festival and then describe his impressions on his site.As any creative person, Valentine is very susceptive. After he watched the movie of a certain genre, Valentine forms the mood he preserves until he watches the next movie. If the genre of the next movie is the same, it does not change Valentine's mood. If the genres are different, Valentine's mood changes according to the new genre and Valentine has a stress.Valentine can't watch all n movies, so he decided to exclude from his to-watch list movies of one of the genres. In other words, Valentine is going to choose exactly one of the k genres and will skip all the movies of this genre. He is sure to visit other movies.Valentine wants to choose such genre x (1 ≤ x ≤ k), that the total number of after-movie stresses (after all movies of genre x are excluded) were minimum.

The first line of the input contains two integers n and k (2 ≤ k ≤ n ≤ 105), where n is the number of movies and k is the number of genres. The second line of the input contains a sequence of n positive integers a1, a2, ..., an (1 ≤ ai ≤ k), where ai is the genre of the i-th movie. It is guaranteed that each number from 1 to k occurs at least once in this sequence.

Print a single number — the number of the genre (from 1 to k) of the excluded films. If there are multiple answers, print the genre with the minimum number.

NoteIn the first sample if we exclude the movies of the 1st genre, the genres 2, 3, 2, 3, 3, 3 remain, that is 3 stresses; if we exclude the movies of the 2nd genre, the genres 1, 1, 3, 3, 3, 1, 1, 3 remain, that is 3 stresses; if we exclude the movies of the 3rd genre the genres 1, 1, 2, 2, 1, 1 remain, that is 2 stresses.In the second sample whatever genre Valentine excludes, he will have exactly 3 stresses.

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

go [x, y] = [(y, 1)]
go (x:t@(y:z:_)) = (y, if x == z then 2 else 1): go t

main = do
  (n:m:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let b@(x:y:_) = map head $ group a
      c = [(-e, i) | (i, e) <- assocs $ accumArray (+) 0 (1,m) $ (x, 1): go b]
  print $ snd $ minimum c

import Data.Array

main = do
    [_, k] <- fmap (map read . words) getLine :: IO [Int]
    a <- fmap (squeeze . map read . words) getLine :: IO [Int]
    let triples = allTriples a
    let saves = accumArray (+) 0 (0, k) $ map (\(x,y,z) -> (y, if x == z then 2 else 1)) triples
    let best = maximum $ elems $ saves
    print $ head $ filter ((== best) . (saves !)) [1..k]

squeeze xs = squeeze' xs []
    where
        squeeze' [] ys = ys
        squeeze' (x:xs) [] = squeeze' xs [x]
        squeeze' (x:xs) (y:ys) = squeeze' xs $ if x == y then y:ys else x:y:ys

allTriples (x:y:xs) = allTriples' (x:y:xs) [(0,x,y)]
    where
        allTriples' [x,y] ts = (x,y,0):ts
        allTriples' (x:y:z:xs) ts = allTriples' (y:z:xs) $ (x,y,z):ts

import Control.Monad (liftM)
import Data.Array.ST
import Data.Array.Unboxed
import Data.Char (ord)
import Data.List (group)
import Prelude hiding (reads)

reads :: IO [Int]
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 + ord c - ord '0'

solve :: Int -> [Int] -> Int
solve k as  =  head $ filter ((== maxStress) . (array !)) [1..k]
  where
    maxStress  =  maximum $ elems array
    array :: UArray Int Int
    array  =  runSTUArray $ do
        array  <-  newArray (1, k) 0
        writeArray array (head as) 1
        update array $ map head $ group as
        return array
    update array (x:y:z:gs)  =  do
        a  <-  readArray array y
        writeArray array y (a + if x == z then 2 else 1)
        update array (y:z:gs)
    update array (x:y:[])  =  do
        a  <-  readArray array y
        writeArray array y (a+1)
    update array _  =  return ()

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

import Control.Applicative
import Data.Array.Base
import Data.Array.IO (IOUArray)
import Data.List
import Data.Ord
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,k] <- map read.words <$> getLine
  xs <- map head.group.map readInt.B.words <$> B.getLine
  arr <- newArray (0,k) 0 :: IO (IOUArray Int Int)
  let solve (x:y:z:rest)
        | x==z = do
            cntx <- unsafeRead arr x
            unsafeWrite arr x $! cntx-1
            cnty <- unsafeRead arr y
            unsafeWrite arr y $! cnty-1
            solve (y:z:rest)
        | otherwise = do
            cntx <- unsafeRead arr x
            unsafeWrite arr x $! cntx-1
            solve (y:z:rest)
      solve [x,y] = do
        cntx <- unsafeRead arr x
        unsafeWrite arr x $! cntx-1
        cnty <- unsafeRead arr y
        unsafeWrite arr y $! cnty-1
  solve xs
  ans <- zip[1..] <$> mapM (unsafeRead arr) [1..k]
  print.fst $ minimumBy (comparing snd) ans

import Data.Array

compress::(Eq a) => [a] -> [a]
compress (x:y:xs) = if x == y then t else x:t
    where t = compress (y:xs)
compress [x] = [x]
compress [] = []

analysis [_, x] = [(x, 1)]
analysis (x:xs@(y:z:_)) = (y, if x == z then 2 else 1):analysis xs

main = do
    line <- getLine
    let (n:m:_) = map read $ words line :: [Int]
    line <- getLine
    let a = map read $ words line :: [Int]
    let c = assocs $ accumArray (+) 0 (1, m) $ (head a, 1) : (analysis $ compress a)
    putStrLn $ show $ snd $ minimum $ map (\(a, b) -> (-b, a)) c

import Data.Array

compress (x:xs@(y:_)) = (if x == y then [] else [x]) ++ compress xs
compress [x] = [x]
compress [] = []

analysis [_, x] = [(x, 1)]
analysis (x:xs@(y:z:_)) = (y, if x == z then 2 else 1):analysis xs

main = do
    line <- getLine
    let (n:m:_) = map read $ words line :: [Int]
    line <- getLine
    let a = map read $ words line :: [Int]
    let c = assocs $ accumArray (+) 0 (1, m) $ (head a, 1) : (analysis $ compress a)
    putStrLn $ show $ snd $ minimum $ map (\(a, b) -> (-b, a)) c

import Data.List
import Data.Array

analysis :: [Int] -> [(Int, Int)]
analysis [_, x] = [(x, 1)]
analysis (x:xs@(y:z:_)) = (y, if x == z then 2 else 1) : analysis xs

answer :: Int -> [Int] -> Int
answer m a = snd $ minimum $ map (\(a, b) -> (-b, a)) c
  where b = map head $ group a
        c = assocs $ accumArray (+) 0 (1, m) $ (head a, 1) : analysis b

main = do
    line <- getLine
    let (n:m:_) = map read $ words line :: [Int]
    line <- getLine
    let a = map read $ words line :: [Int]
    putStrLn $ show $ answer m a

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

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Data.List
import Debug.Trace

import Numeric
readInt :: String -> Int
readInt !s = case readDec s of [(n, "")] -> n
-- readInt ('-':s) = case readDec s of [(n, "")] -> -n

preprocess = map head . group

maxN = 500000

ex1 = [1, 1, 2, 3, 2, 3, 3, 1, 1, 3]

solve :: [Int] -> Int
solve [x] = 1
solve xs@(x:_) = runST $ do
  ar <- (newArray (1, maxN) 0)::ST s (STArray s Int Int)
  solve' (x:xs) ar
  res <- newSTRef 1
  forM_ [1..maxN] $ (\i -> do
    a <- readArray ar i
    r <- readSTRef res
    b <- readArray ar r
    when (a > b)
      (writeSTRef res i))
  readSTRef res

modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m ()
modifyArray ar f i = do
  x <- readArray ar i
  writeArray ar i (f x)

solve' (a:b:c:rest) ar = do
  if a == c
  then modifyArray ar (+2) b
  else modifyArray ar (+1) b
  solve' (b:c:rest) ar
solve' (a:[b]) ar = do
  modifyArray ar (+1) (b::Int)

main = do
  _ <- getLine
  movies <- getLine >>= (return . map Main.readInt . words)
  print . solve . preprocess $  movies

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

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Data.List
import Debug.Trace

import Numeric
readInt :: String -> Int
readInt !s = case readDec s of [(n, "")] -> n
-- readInt ('-':s) = case readDec s of [(n, "")] -> -n

preprocess = map head . group

maxN = 500000

ex1 = [1, 1, 2, 3, 2, 3, 3, 1, 1, 3]

solve :: [Int] -> Int
solve [x] = 1
solve !xs@(x:_) = runST $ do
  ar <- (newArray (1, maxN) 0)::ST s (STArray s Int Int)
  solve' (x:xs) ar
  res <- newSTRef 1
  forM_ [1..maxN] $ (\i -> do
    a <- readArray ar i
    r <- readSTRef res
    b <- readArray ar r
    when (a > b)
      (writeSTRef res i))
  readSTRef res

modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m ()
modifyArray ar f i = do
  x <- readArray ar i
  writeArray ar i (f x)

solve' (a:b:c:rest) ar = do
  if a == c
  then modifyArray ar (+2) b
  else modifyArray ar (+1) b
  solve' (b:c:rest) ar
solve' (a:[b]) ar = do
  modifyArray ar (+1) (b::Int)

main = do
  _ <- getLine
  movies <- getLine >>= (return . map Main.readInt . words)
  print . solve . preprocess $  movies

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

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Data.List
import Debug.Trace

preprocess = map head . group

maxN = 500000

ex1 = [1, 1, 2, 3, 2, 3, 3, 1, 1, 3]

solve :: [Int] -> Int
solve [x] = 1
solve xs@(x:_) = runST $ do
  ar <- (newArray (1, maxN) 0)::ST s (STArray s Int Int)
  solve' (x:xs) ar
  res <- newSTRef 1
  forM_ [1..maxN] $ (\i -> do
    a <- readArray ar i
    r <- readSTRef res
    b <- readArray ar r
    when (a > b)
      (writeSTRef res i))
  readSTRef res

modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m ()
modifyArray ar f i = do
  x <- readArray ar i
  writeArray ar i (f x)

solve' (a:b:c:rest) ar = do
  if a == c
  then modifyArray ar (+2) b
  else modifyArray ar (+1) b
  solve' (b:c:rest) ar
solve' (a:[b]) ar = do
  modifyArray ar (+1) (b::Int)

main = do
  _ <- getLine
  movies <- getLine >>= (return . map read . words)
  print . solve . preprocess $  movies

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# OPTIONS_GHC -fasm #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Data.List
import Debug.Trace

import Numeric
readInt :: String -> Int
readInt !s = case readDec s of [(n, "")] -> n
-- readInt ('-':s) = case readDec s of [(n, "")] -> -n

preprocess = map head . group

maxN = 500000

ex1 = [1, 1, 2, 3, 2, 3, 3, 1, 1, 3]

solve :: [Int] -> Int
solve [x] = 1
solve xs@(x:_) = runST $ do
  ar <- (newArray (1, maxN) 0)::ST s (STArray s Int Int)
  solve' (x:xs) ar
  res <- newSTRef 1
  forM_ [1..maxN] $ (\i -> do
    a <- readArray ar i
    r <- readSTRef res
    b <- readArray ar r
    when (a > b)
      (writeSTRef res i))
  readSTRef res

modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m ()
modifyArray ar f i = do
  x <- readArray ar i
  writeArray ar i (f x)

solve' (a:b:c:rest) ar = do
  if a == c
  then modifyArray ar (+2) b
  else modifyArray ar (+1) b
  solve' (b:c:rest) ar
solve' (a:[b]) ar = do
  modifyArray ar (+1) (b::Int)

main = do
  _ <- getLine
  movies <- getLine >>= (return . map Main.readInt . words)
  print . solve . preprocess $  movies


After defeating a Blacklist Rival, you get a chance to draw $$$1$$$ reward slip out of $$$x$$$ hidden valid slips. Initially, $$$x=3$$$ and these hidden valid slips are Cash Slip, Impound Strike Release Marker and Pink Slip of Rival's Car. Initially, the probability of drawing these in a random guess are $$$c$$$, $$$m$$$, and $$$p$$$, respectively. There is also a volatility factor $$$v$$$. You can play any number of Rival Races as long as you don't draw a Pink Slip. Assume that you win each race and get a chance to draw a reward slip. In each draw, you draw one of the $$$x$$$ valid items with their respective probabilities. Suppose you draw a particular item and its probability of drawing before the draw was $$$a$$$. Then,  If the item was a Pink Slip, the quest is over, and you will not play any more races.  Otherwise,   If $$$a\leq v$$$, the probability of the item drawn becomes $$$0$$$ and the item is no longer a valid item for all the further draws, reducing $$$x$$$ by $$$1$$$. Moreover, the reduced probability $$$a$$$ is distributed equally among the other remaining valid items.  If $$$a > v$$$, the probability of the item drawn reduces by $$$v$$$ and the reduced probability is distributed equally among the other valid items.  For example,  If $$$(c,m,p)=(0.2,0.1,0.7)$$$ and $$$v=0.1$$$, after drawing Cash, the new probabilities will be $$$(0.1,0.15,0.75)$$$.  If $$$(c,m,p)=(0.1,0.2,0.7)$$$ and $$$v=0.2$$$, after drawing Cash, the new probabilities will be $$$(Invalid,0.25,0.75)$$$.  If $$$(c,m,p)=(0.2,Invalid,0.8)$$$ and $$$v=0.1$$$, after drawing Cash, the new probabilities will be $$$(0.1,Invalid,0.9)$$$.  If $$$(c,m,p)=(0.1,Invalid,0.9)$$$ and $$$v=0.2$$$, after drawing Cash, the new probabilities will be $$$(Invalid,Invalid,1.0)$$$. You need the cars of Rivals. So, you need to find the expected number of races that you must play in order to draw a pink slip.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 10$$$)  — the number of test cases. The first and the only line of each test case contains four real numbers $$$c$$$, $$$m$$$, $$$p$$$ and $$$v$$$ ($$$0 < c,m,p < 1$$$, $$$c+m+p=1$$$, $$$0.1\leq v\leq 0.9$$$). Additionally, it is guaranteed that each of $$$c$$$, $$$m$$$, $$$p$$$ and $$$v$$$ have at most $$$4$$$ decimal places.

For each test case, output a single line containing a single real number — the expected number of races that you must play in order to draw a Pink Slip. Your answer is considered correct if its absolute or relative error does not exceed $$$10^{-6}$$$. Formally, let your answer be $$$a$$$, and the jury's answer be $$$b$$$. Your answer is accepted if and only if $$$\frac{|a - b|}{\max{(1, |b|)}} \le 10^{-6}$$$.

NoteFor the first test case, the possible drawing sequences are:   P with a probability of $$$0.6$$$;  CP with a probability of $$$0.2\cdot 0.7 = 0.14$$$;  CMP with a probability of $$$0.2\cdot 0.3\cdot 0.9 = 0.054$$$;  CMMP with a probability of $$$0.2\cdot 0.3\cdot 0.1\cdot 1 = 0.006$$$;  MP with a probability of $$$0.2\cdot 0.7 = 0.14$$$;  MCP with a probability of $$$0.2\cdot 0.3\cdot 0.9 = 0.054$$$;  MCCP with a probability of $$$0.2\cdot 0.3\cdot 0.1\cdot 1 = 0.006$$$.  So, the expected number of races is equal to $$$1\cdot 0.6 + 2\cdot 0.14 + 3\cdot 0.054 + 4\cdot 0.006 + 2\cdot 0.14 + 3\cdot 0.054 + 4\cdot 0.006 = 1.532$$$.For the second test case, the possible drawing sequences are:   P with a probability of $$$0.4$$$;  CP with a probability of $$$0.4\cdot 0.6 = 0.24$$$;  CMP with a probability of $$$0.4\cdot 0.4\cdot 1 = 0.16$$$;  MP with a probability of $$$0.2\cdot 0.5 = 0.1$$$;  MCP with a probability of $$$0.2\cdot 0.5\cdot 1 = 0.1$$$. So, the expected number of races is equal to $$$1\cdot 0.4 + 2\cdot 0.24 + 3\cdot 0.16 + 2\cdot 0.1 + 3\cdot 0.1 = 1.86$$$.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

expval :: Double -> Double -> Double -> Double -> Double -> Double -> Double
expval c m p v rounds acc = expc + expm + expp
  where (validc, validm) = (c*rounds*acc > 1e-11, m*rounds*acc > 1e-11)
        expc = (if not validc then 0 else (let r = min c v
                                               (pp, mm) = (if validm then (r/2, r/2) else (r, 0))
                                       in expval (c-v) (m+mm) (p+pp) v (rounds+1) (acc*c)))
        expm = (if not validm then 0 else (let r = min m v
                                               (pp, cc) = (if validc then (r/2, r/2) else (r, 0))
                                       in expval (c+cc) (m-v) (p+pp) v (rounds+1) (acc*m)))
        expp = acc*p*rounds

solve :: IO ()
solve = do
  s <- getLine
  let [c, m, p, v] = map read $ words s :: [Double]
      expected = expval c m p v 1 1.0
    in print expected

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

import Control.Monad ( replicateM_ )
import Data.Int ( Int64 )
import Numeric ( showFFloat )

solve :: IO ()
solve = do
    [c, m, p, v] <- readMany :: IO [Double]
    let ans = go c m p 1 1
        go c m p d pr =
            let tryP = d * pr * p
                tryC | c <= v + eps = go' (m + c / 2) (p + c / 2) (d + 1) (pr * c)
                     | otherwise    = go (c - v) (m + v / 2) (p + v / 2) (d + 1) (pr * c)
                tryM | m <= v + eps = go' (c + m / 2) (p + m / 2) (d + 1) (pr * m)
                     | otherwise    = go (c + v / 2) (m - v) (p + v / 2) (d + 1) (pr * m)
            in tryC + tryM + tryP
        go' c p d pr =
            let tryP = d * pr * p
                tryC | c <= v + eps = (d + 1) * (pr * c)
                     | otherwise    = go' (c - v) (p + v) (d + 1) (pr * c)
            in tryP + tryC
        eps = 1e-8
    putStrLn $ showFFloat (Just 12) ans ""

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

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


You are given three sequences: $$$a_1, a_2, \ldots, a_n$$$; $$$b_1, b_2, \ldots, b_n$$$; $$$c_1, c_2, \ldots, c_n$$$.For each $$$i$$$, $$$a_i \neq b_i$$$, $$$a_i \neq c_i$$$, $$$b_i \neq c_i$$$.Find a sequence $$$p_1, p_2, \ldots, p_n$$$, that satisfy the following conditions: $$$p_i \in \{a_i, b_i, c_i\}$$$ $$$p_i \neq p_{(i \mod n) + 1}$$$.In other words, for each element, you need to choose one of the three possible values, such that no two adjacent elements (where we consider elements $$$i,i+1$$$ adjacent for $$$i<n$$$ and also elements $$$1$$$ and $$$n$$$) will have equal value.It can be proved that in the given constraints solution always exists. You don't need to minimize/maximize anything, you need to find any proper sequence.

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$): the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$3 \leq n \leq 100$$$): the number of elements in the given sequences. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 100$$$). The third line contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \leq b_i \leq 100$$$). The fourth line contains $$$n$$$ integers $$$c_1, c_2, \ldots, c_n$$$ ($$$1 \leq c_i \leq 100$$$). It is guaranteed that $$$a_i \neq b_i$$$, $$$a_i \neq c_i$$$, $$$b_i \neq c_i$$$ for all $$$i$$$.

For each test case, print $$$n$$$ integers: $$$p_1, p_2, \ldots, p_n$$$ ($$$p_i \in \{a_i, b_i, c_i\}$$$, $$$p_i \neq p_{i \mod n + 1}$$$). If there are several solutions, you can print any.

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

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

test :: IO ()
test = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  cs <- map read . words <$> getLine
  let trips = zip3 as bs cs :: [(Integer, Integer, Integer)]
  putStrLn $ unwords . map show $ solve trips

solve :: Eq t => [(t, t, t)] -> [t]
solve [] = []
solve ((end, _, _) : trips) = end : f trips end
  where
    f [] _ = []
    f [(a, b, c)] pre = pure $ head $ filter (`notElem` [pre, end]) [a, b, c]
    f ((a, b, c) : t) pre = let e = head $ filter (/= pre) [a, b, c] in e : f t e

import Control.Monad

solve :: [(Int, Int, Int)] -> [Int]
solve [] = []
solve ((p, _, _) : xs) = let
  go _ [] = []
  go prev ((x, y, z) : zs) = let
    next = head [v | v <- [x, y, z], notElem v [p, prev]]
    in  next : go next zs
  in  p : go p xs

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    [a, b, c] <- replicateM 3 $ map read . words <$> getLine
    putStrLn . unwords . map show . solve $ zip3 a b c


Alice and Bob play a game. They have a binary string $$$s$$$ (a string such that each character in it is either $$$0$$$ or $$$1$$$). Alice moves first, then Bob, then Alice again, and so on.During their move, the player can choose any number (not less than one) of consecutive equal characters in $$$s$$$ and delete them.For example, if the string is $$$10110$$$, there are $$$6$$$ possible moves (deleted characters are bold):  $$$\textbf{1}0110 \to 0110$$$;  $$$1\textbf{0}110 \to 1110$$$;  $$$10\textbf{1}10 \to 1010$$$;  $$$101\textbf{1}0 \to 1010$$$;  $$$10\textbf{11}0 \to 100$$$;  $$$1011\textbf{0} \to 1011$$$. After the characters are removed, the characters to the left and to the right of the removed block become adjacent. I. e. the following sequence of moves is valid: $$$10\textbf{11}0 \to 1\textbf{00} \to 1$$$.The game ends when the string becomes empty, and the score of each player is the number of $$$1$$$-characters deleted by them.Each player wants to maximize their score. Calculate the resulting score of Alice.

The first line contains one integer $$$T$$$ ($$$1 \le T \le 500$$$) — the number of test cases. Each test case contains exactly one line containing a binary string $$$s$$$ ($$$1 \le |s| \le 100$$$).

For each test case, print one integer — the resulting score of Alice (the number of $$$1$$$-characters deleted by her).

NoteQuestions about the optimal strategy will be ignored.

import Data.List

readOneInt :: IO Int
readOneInt = do
    line_ <- getLine
    return $ read line_

strangeSum :: [Int] -> Int
strangeSum [] = 0
strangeSum [a] = a
strangeSum [a,_] = a
strangeSum (a:_:cs) = a + (strangeSum cs)

main :: IO ()
main = do
    t <- readOneInt
    for t where
        for 0 = return ()
        for t' = do
            line_ <- getLine
            -- foldr is more correct, but i am jerk
            let counts = foldl (\acc c ->
                    if null acc
                        then [(c, 1)]
                        else if c == (fst $ head acc)
                            then (c, 1 + (snd $ head acc)) : (tail acc)
                            else (c, 1) : acc) [] line_
            let oneCounts = reverse $ sort $ snd $ unzip $ filter (\(c,_) -> c=='1') counts
            putStrLn $ show $ strangeSum oneCounts
            for (t'-1)

import Control.Monad
import Data.List
import Data.Function
import Data.Ord

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

routine :: IO ()
routine = do
  n <- getLine
  print $ solve n

solve :: String -> Int
solve s = compute grp
  where
    grp = (sortBy (compare `on` Down)  .map length.filter (\(x:_) -> x=='1').group) s

compute :: [Int] -> Int
compute (x:_:xs) = x + compute xs
compute [x] = x
compute [] = 0

import Data.List
--import Data.Sort
getBlocks :: String -> [Int]
getBlocks x = reverse $ getBlocks' 0 [] x
getBlocks' :: Int -> [Int] -> String -> [Int]
getBlocks' cur a "" = if cur > 0 then (cur : a) else a
getBlocks' cur a ('0' : xs) = if cur > 0 then getBlocks' 0 (cur : a) xs else getBlocks' cur a xs
getBlocks' cur a ('1' : xs) = getBlocks' (cur + 1) a xs
solveTestCase :: String -> Int
solveTestCase s = let decreasingBlocks = (reverse . sort . getBlocks) s in
                  let numBlocks = length decreasingBlocks in
                  let indices = [0 .. numBlocks - 1] in
                  let valuesAtEvenIndices = map fst $ filter (even . snd) $ zip decreasingBlocks indices in
                  sum valuesAtEvenIndices
doCasesIO :: Int -> IO ()
doCasesIO 0 = return ()
doCasesIO t = do
              s <- getLine
              (putStrLn . show . solveTestCase) s
              doCasesIO (t - 1)
main :: IO ()
main = do
         t <- readLn :: IO Int
         doCasesIO t

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: String -> Int
solve s = sum oddOneGroupLengths
    where
        oddOneGroupLengths = map snd . filter (odd . fst) . zip [1..] $ oneGroupLengths
        oneGroupLengths = reverse . sort . map snd $ oneGroups
        oneGroups = filter fst groups
        groups = map (\s -> (head s == '1', length s)) $ group s

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        s <- B8.getLine
        let answer = solve $ B8.unpack s
        printf "%d\n" answer

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

type Input = String
type Output = Int

solve :: String -> String
solve input = intercalate "\n" formattedOutputs
    where
        _:xs = words input
        inputs = inputParser xs
        outputs = map solver inputs
        formattedOutputs = map outputFormatter outputs

inputParser :: [String] -> [Input]
inputParser x = x

outputFormatter :: Output -> String
outputFormatter x = show x

solver :: Input -> Output
solver x =
    let
        nums = sortBy (\a b -> compare b a) . map length . filter (('1' ==) . head) $ group x
        folder :: [Int] -> Int
        folder [] = 0
        folder (x:[]) = x
        folder (x:xx:[]) = x
        folder (x:xx:xs) = x + folder xs
    in folder nums


Some large corporation where Polycarpus works has its own short message service center (SMSC). The center's task is to send all sorts of crucial information. Polycarpus decided to check the efficiency of the SMSC. For that, he asked to give him the statistics of the performance of the SMSC for some period of time. In the end, Polycarpus got a list of n tasks that went to the SMSC of the corporation. Each task was described by the time it was received by the SMSC and the number of text messages to send. More formally, the i-th task was described by two integers ti and ci — the receiving time (the second) and the number of the text messages, correspondingly.Polycarpus knows that the SMSC cannot send more than one text message per second. The SMSC uses a queue to organize its work. Consider a time moment x, the SMSC work at that moment as follows:  If at the time moment x the queue is not empty, then SMSC sends one message from the queue (SMSC gets the message from the head of the queue). Otherwise it doesn't send messages at the time moment x.  If at the time moment x SMSC receives a task, then it adds to the queue all the messages from this task (SMSC adds messages to the tail of the queue). Note, that the messages from the task cannot be send at time moment x. That's because the decision about sending message or not is made at point 1 before adding these messages to the queue. Given the information about all n tasks, Polycarpus wants to count two values: the time when the last text message was sent and the maximum size of the queue at some time. Help him count these two characteristics he needs to evaluate the efficiency of the SMSC.

The first line contains a single integer n (1 ≤ n ≤ 103) — the number of tasks of the SMSC. Next n lines contain the tasks' descriptions: the i-th line contains two space-separated integers ti and ci (1 ≤ ti, ci ≤ 106) — the time (the second) when the i-th task was received and the number of messages to send, correspondingly. It is guaranteed that all tasks were received at different moments of time. It is guaranteed that the tasks are sorted in the chronological order, that is, ti < ti + 1 for all integer i (1 ≤ i < n).

In a single line print two space-separated integers — the time when the last text message was sent and the maximum queue size at a certain moment of time.

NoteIn the first test sample:   second 1: the first message has appeared in the queue, the queue's size is 1;  second 2: the first message is sent, the second message has been received, the queue's size is 1;  second 3: the second message is sent, the queue's size is 0, Thus, the maximum size of the queue is 1, the last message was sent at the second 3.

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

main :: IO ()
main = do
  a <- pairs . tail . map readInt . C.words <$> C.getContents
  let (t, c, maxc) = foldl gao (0, 0, 0) a
  print $ t + c
  print $ maxc
  where
    gao (t, c, maxc) (tt, cc) = let c' = cc + max 0 (c - (tt - t)) in (tt, c', max maxc $ c')

toList::[Int]->[(Int,Int)]
toList [] = []
toList (a:b:c) = (a,b):(toList c)

getAns::[(Int,Int)]->(Int,Int)
getAns lst =
 let
  getAns'::[(Int,Int)]->Int->Int->Int->(Int,Int)
  getAns' [] unfinishedTask currentTime maxTask = (currentTime+unfinishedTask,maxTask)
  getAns' ((t,c):xs) unfinishedTask currentTime maxTask =
   if t==currentTime
    then getAns' xs (unfinishedTask+c) currentTime (max maxTask (unfinishedTask+c))
    else getAns' ((t,c):xs) (max (unfinishedTask-t+currentTime) 0) t maxTask
 in getAns' lst 0 0 0

main::IO()
main =
 do
 input <- getContents
 let
  numbers = map read (words input)::[Int]
  ans = getAns $ toList $ tail numbers
 putStr $ show $ fst ans
 putStr " "
 putStr $ show $ snd ans
 putStr "\n"

import Control.Monad (liftM, replicateM)
import Data.Array ((!), accumArray, listArray, elems)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [(Int, Int)] -> [Int]
solve ms  =  solve' 0 0 0 ms
  where
    solve' t 0 maxQ []  =  [t, maxQ]
    solve' t q maxQ []  =  solve' (t+q) 0 (max maxQ q) []
    solve' t q maxQ ((ti, ci) : ms)
      | q <= (ti - t)  =  solve' ti ci (max maxQ q) ms
      | otherwise  =  solve' ti (q - (ti - t) + ci) (max maxQ q) ms

main :: IO ()
main  =  do
    n  <-  readLn
    ms  <-  replicateM n readPair
    prints $ solve ms

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

    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')

get::String->Int
get x=read x

gao::(Int,Int,Int)->(Int,Int)->(Int,Int,Int)
gao (nowmaxPeople,nowTime,nowres) (t,k) = ( max nowmaxPeople nw,t,nw )
	where nw=( max (nowres-(t-nowTime)) 0 )+k

myfst::(Int,Int,Int)->Int
myfst (x,_,_)=x

mysnd::(Int,Int,Int)->Int
mysnd (_,x,_)=x

mythd::(Int,Int,Int)->Int
mythd (_,_,x)=x

work::[(Int,Int)]->(Int,Int,Int)->String
work [] x = show ( mysnd x + mythd x ) ++ " " ++ show ( myfst x )
work (a:as) x = work as (gao x a)

get2::[Int]->[(Int,Int)]
get2 xs = zip ( map (xs!!) [1,3..2*n] ) ( map (xs!!) [2,4..2*n] )
	where n=xs!!0

main::IO()
main = do
	input<-getContents
	let
		number=map read (words input)::[Int]
	putStr $ work ( get2 number ) (0,0,0)

toList::[Int]->[(Int,Int)]
toList [] = []
toList (a:b:c) = (a,b):(toList c)

getAns::[(Int,Int)]->(Int,Int)
getAns lst =
 let
  getAns'::[(Int,Int)]->Int->Int->Int->(Int,Int)
  getAns' [] unfinishedTask currentTime maxTask = (currentTime+unfinishedTask,maxTask)
  getAns' ((t,c):xs) unfinishedTask currentTime maxTask =
   if t==currentTime
    then getAns' xs (unfinishedTask+c) currentTime (max maxTask ((max (unfinishedTask-1) 0)+c))
    else getAns' ((t,c):xs) (max (unfinishedTask-t+currentTime) 0) t maxTask
 in getAns' lst 0 0 0

main::IO()
main =
 do
 input <- getContents
 let
  numbers = map read (words input)::[Int]
  ans = getAns $ toList $ tail numbers
 putStr $ show $ fst ans
 putStr " "
 putStr $ show $ snd ans
 putStr "\n"


Ivan is playing yet another roguelike computer game. He controls a single hero in the game. The hero has $$$n$$$ equipment slots. There is a list of $$$c_i$$$ items for the $$$i$$$-th slot, the $$$j$$$-th of them increases the hero strength by $$$a_{i,j}$$$. The items for each slot are pairwise distinct and are listed in the increasing order of their strength increase. So, $$$a_{i,1} < a_{i,2} < \dots < a_{i,c_i}$$$.For each slot Ivan chooses exactly one item. Let the chosen item for the $$$i$$$-th slot be the $$$b_i$$$-th item in the corresponding list. The sequence of choices $$$[b_1, b_2, \dots, b_n]$$$ is called a build.The strength of a build is the sum of the strength increases of the items in it. Some builds are banned from the game. There is a list of $$$m$$$ pairwise distinct banned builds. It's guaranteed that there's at least one build that's not banned.What is the build with the maximum strength that is not banned from the game? If there are multiple builds with maximum strength, print any of them.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10$$$) — the number of equipment slots. The $$$i$$$-th of the next $$$n$$$ lines contains the description of the items for the $$$i$$$-th slot. First, one integer $$$c_i$$$ ($$$1 \le c_i \le 2 \cdot 10^5$$$) — the number of items for the $$$i$$$-th slot. Then $$$c_i$$$ integers $$$a_{i,1}, a_{i,2}, \dots, a_{i,c_i}$$$ ($$$1 \le a_{i,1} < a_{i,2} < \dots < a_{i,c_i} \le 10^8$$$). The sum of $$$c_i$$$ doesn't exceed $$$2 \cdot 10^5$$$. The next line contains a single integer $$$m$$$ ($$$0 \le m \le 10^5$$$) — the number of banned builds. Each of the next $$$m$$$ lines contains a description of a banned build — a sequence of $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le c_i$$$). The builds are pairwise distinct, and there's at least one build that's not banned.

Print the build with the maximum strength that is not banned from the game. If there are multiple builds with maximum strength, print any of them.

import Control.Monad
import Data.Array.Unboxed
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n] <- readInts
    cas <- replicateM n $ (\(x:cs) -> listArray (1, x) cs :: UArray Int Int) <$> readInts
    [m] <- readInts
    bs <- S.fromList <$> replicateM m readInts
    let next = init . go where
            go [] = [[]]
            go (1:is) = map (1:) $ go is
            go (i:is) = (i - 1 : is) : map (i:) (go is)
        candidates = filter (`S.notMember` bs) $ map (snd . bounds) cas : concatMap next (S.elems bs)
        score is = sum $ [fromIntegral $ ca!i | (i, ca) <- zip is cas] :: Int64
    putStrLn $ unwords $ map show $ maximumBy (comparing score) candidates

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

main :: IO ()
main = solve

import Control.Monad
import Data.Array
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n] <- readInts
    cas <- replicateM n $ (\(x:cs) -> listArray (1, x) cs) <$> readInts
    [m] <- readInts
    bs <- S.fromList <$> replicateM m readInts
    let next = init . go where
            go [] = [[]]
            go (1:is) = map (1:) $ go is
            go ~(i:is) = (i - 1 : is) : map (i:) (go is)
        candidates = filter (`S.notMember` bs) $ [snd $ bounds ca | ca <- cas] : concatMap next (S.elems bs)
        score is = sum $ [fromIntegral $ ca!i | (i, ca) <- zip is cas] :: Int64
    putStrLn $ unwords $ map show $ maximumBy (comparing score) candidates

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

main :: IO ()
main = solve

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Applicative        (liftA2)
import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import qualified Data.Foldable              as F
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), ViewR (..), (<|),
                                             (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

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

data TC = TC { slots :: [[Choice]], banned :: [[Int]] }

tc = do
  n <- int
  TC <$> (n >< (zipWith Choice [1 ..] <$> numberOf int)) <*> numberOf (n >< int)

main = C.interact $
  runScanner tc >>> solve >>> map (show >>> C.pack) >>> C.unwords

solve :: TC -> [Int]
solve TC{..} = choices . fromJust $ find ((`S.notMember` bannedSet) . choices) bs
  where
    bannedSet = S.fromList banned
    revSlots = map reverse slots
    bs = builds revSlots

-- Sorted in *decreasing* order.

data Choice = Choice { index :: !Int, value :: !Int }

data Build = Build { strength :: !Int, choices :: [Int] }
  deriving (Eq, Show, Ord)

singletonBuild :: Choice -> Build
singletonBuild (Choice i v) = Build v [i]

mkBuild xs = Build (sum xs) xs

-- Pre: all input lists are sorted descending.
-- All possible builds, sorted in descending order of strength.
builds :: [[Choice]] -> [Build]
builds []     = []
builds (i:is) = chooseFrom i (builds is)

chooseFrom :: [Choice] -> [Build] -> [Build]
chooseFrom [] _  = []
chooseFrom xs [] = map singletonBuild xs
chooseFrom (x:xs) (b:bs) = addToBuild x b : mergeBuilds (map (addToBuild x) bs) (chooseFrom xs (b:bs))

addToBuild :: Choice -> Build -> Build
addToBuild (Choice i v) (Build s xs) = Build (v+s) (i:xs)

mergeBuilds xs [] = xs
mergeBuilds [] ys = ys
mergeBuilds (x:xs) (y:ys) = case compare (strength x) (strength y) of
  GT -> x : mergeBuilds xs (y:ys)
  _  -> y : mergeBuilds (x:xs) ys

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

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = head <$> get

str :: Scanner C.ByteString
str = get >>= \case { s:ss -> put ss >> return s }

int :: Scanner Int
int = (fst . fromJust . C.readInt) <$> str

integer :: Scanner Integer
integer = (read . C.unpack) <$> str

double :: Scanner Double
double = (read . C.unpack) <$> str

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

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

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

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  case p t of
    True  -> return []
    False -> (:) <$> s <*> till p s

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

(><) = times

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

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

import Control.Monad
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n] <- readInts
    cs <- replicateM n $ reverse . zip [1..] . tail <$> readInts
    [m] <- readInts
    bs <- S.fromList <$> replicateM m readInts
    let pop [x] = [x]
        pop ~(_:xs) = xs
        diff [x] = 10^9
        diff ~(x:x':_) = snd x - snd x'
        sub [] [] = [[]]
        sub ~(x:xs) ~(y:ys) = (y:xs) : map (x:) (sub xs ys)
        go cs
            | sig `S.notMember` bs = sig
            | otherwise = go cs'
          where
            sig = map (fst . head) cs
            diffs = map diff cs
            newcs = init $ sub cs $ map pop cs
            cs' = snd $ minimumBy (comparing fst) $ zip diffs newcs
    putStrLn $ unwords $ map show $ go cs

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

main :: IO ()
main = solve


$$$n$$$ people live on the coordinate line, the $$$i$$$-th one lives at the point $$$x_i$$$ ($$$1 \le i \le n$$$). They want to choose a position $$$x_0$$$ to meet. The $$$i$$$-th person will spend $$$|x_i - x_0|$$$ minutes to get to the meeting place. Also, the $$$i$$$-th person needs $$$t_i$$$ minutes to get dressed, so in total he or she needs $$$t_i + |x_i - x_0|$$$ minutes. Here $$$|y|$$$ denotes the absolute value of $$$y$$$.These people ask you to find a position $$$x_0$$$ that minimizes the time in which all $$$n$$$ people can gather at the meeting place.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of test cases. Then the test cases follow. Each test case consists of three lines. The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of people.  The second line contains $$$n$$$ integers $$$x_1, x_2, \dots, x_n$$$ ($$$0 \le x_i \le 10^{8}$$$) — the positions of the people. The third line contains $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$ ($$$0 \le t_i \le 10^{8}$$$), where $$$t_i$$$ is the time $$$i$$$-th person needs to get dressed. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single real number — the optimum position $$$x_0$$$. It can be shown that the optimal position $$$x_0$$$ is unique. Your answer will be considered correct if its absolute or relative error does not exceed $$$10^{−6}$$$. Formally, let your answer be $$$a$$$, the jury's answer be $$$b$$$. Your answer will be considered correct if $$$\frac{|a−b|}{max(1,|b|)} \le 10^{−6}$$$.

Note  In the $$$1$$$-st test case there is one person, so it is efficient to choose his or her position for the meeting place. Then he or she will get to it in $$$3$$$ minutes, that he or she need to get dressed.  In the $$$2$$$-nd test case there are $$$2$$$ people who don't need time to get dressed. Each of them needs one minute to get to position $$$2$$$.  In the $$$5$$$-th test case the $$$1$$$-st person needs $$$4$$$ minutes to get to position $$$1$$$ ($$$4$$$ minutes to get dressed and $$$0$$$ minutes on the way); the $$$2$$$-nd person needs $$$2$$$ minutes to get to position $$$1$$$ ($$$1$$$ minute to get dressed and $$$1$$$ minute on the way); the $$$3$$$-rd person needs $$$4$$$ minutes to get to position $$$1$$$ ($$$2$$$ minutes to get dressed and $$$2$$$ minutes on the way).

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n], xs, ts] <- replicateM 3 ri
        return (xs,ts)
    mapM_ (putStrLn.show.solve) tcs

solve (xs,ts) = ans
  where
    mxT = maximum ts
    dts = map ((-)mxT) ts
    segms = zipWith plusMinus xs dts
    l = minimum . map snd $ segms
    r = maximum . map fst $ segms
    ans = (fromIntegral l + fromIntegral r) / 2 :: Float

plusMinus x d = (x-d, x+d)


You've got an array, consisting of n integers a1, a2, ..., an. Also, you've got m queries, the i-th query is described by two integers li, ri. Numbers li, ri define a subsegment of the original array, that is, the sequence of numbers ali, ali + 1, ali + 2, ..., ari. For each query you should check whether the corresponding segment is a ladder. A ladder is a sequence of integers b1, b2, ..., bk, such that it first doesn't decrease, then doesn't increase. In other words, there is such integer x (1 ≤ x ≤ k), that the following inequation fulfills: b1 ≤ b2 ≤ ... ≤ bx ≥ bx + 1 ≥ bx + 2... ≥ bk. Note that the non-decreasing and the non-increasing sequences are also considered ladders.

The first line contains two integers n and m (1 ≤ n, m ≤ 105) — the number of array elements and the number of queries. The second line contains the sequence of integers a1, a2, ..., an (1 ≤ ai ≤ 109), where number ai stands for the i-th array element. The following m lines contain the description of the queries. The i-th line contains the description of the i-th query, consisting of two integers li, ri (1 ≤ li ≤ ri ≤ n) — the boundaries of the subsegment of the initial array. The numbers in the lines are separated by single spaces.

Print m lines, in the i-th line print word "Yes" (without the quotes), if the subsegment that corresponds to the i-th query is the ladder, or word "No" (without the quotes) otherwise.

import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

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

solve :: [[Int]] -> [String]
solve ([n, m] : as : qs) = map (judge vs) qs
  where
  vs = M.fromList $ findV [] $ zip [1..] as

judge :: M.Map Int Int -> [Int] -> String
judge vs [l, r] = case M.lookupGE l vs of
  Just (i, j)  -> if j <= r then "No" else "Yes"
  Nothing -> "Yes"

findV :: [Int] -> [(Int, Int)] -> [(Int, Int)]
findV  _  ((i, a) : x@(_, b) : xs) | a > b = findV [i] (x : xs)
findV [i] ((_, b) : x@(j, c) : xs) | b < c = (i, j) : findV [] (x : xs)
findV is (x : xs) = findV is xs
findV _ _ = []

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

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.List

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

main = do
  [n,m] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map (\flg -> if flg then "Yes" else "No") $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Bool]
solve n _ qs | n<=2 = replicate (length qs `div` 2) True
solve n xs qs = go qs
   where
     !arr = listArray (0,n-2) $ zipWith (-) (tail xs) xs :: UArray Int Int
     !segtree = mkSegTree 0 (n-2) arr
     go (l:r:rest) = query (l-1) (r-2) segtree : go rest
     go _ = []

data SegTree = Node !Bool !Int !Int !Int !Int !SegTree !SegTree
             | Leaf !Bool !Int !Int

getMin :: SegTree -> Int
getMin (Node _ _ _ val _ _ _) = val
getMin (Leaf _ _ val )        = val

getMax :: SegTree -> Int
getMax (Node _ _ _ _ val _ _) = val
getMax (Leaf _ _ val )        = val

getFlg :: SegTree -> Bool
getFlg (Node flg _ _ _ _ _ _) = flg
getFlg (Leaf flg _ _ ) = flg

mkSegTree :: Int -> Int -> UArray Int Int -> SegTree
mkSegTree l r arr
  | l/=r = do
      let !m = (l+r) `quot` 2
          lt = mkSegTree l m arr
          rt = mkSegTree (m+1) r arr
      Node (getFlg lt && getFlg rt && (getMin lt >= 0 || getMax rt <= 0) ) l r
           (min (getMin lt) (getMin rt)) (max (getMax lt) (getMax rt)) lt rt
  | otherwise = Leaf True l (unsafeAt arr l)

query :: Int -> Int -> SegTree -> Bool
query kl kr segtree = if kl>=kr then True else go segtree
   where
     go (Node flg l r _ _ lt rt)
       | r<kl  || kr<l  = True
       | kl<=l && r<=kr = flg
       | otherwise = go lt && go rt && (queryMin kl kr lt >= 0 || queryMax kl kr rt <= 0)
     go (Leaf _ _ _ ) = True

queryMin :: Int -> Int -> SegTree -> Int
queryMin kl kr segtree = go segtree
   where
     go (Node flg l r v _ lt rt)
       | r<kl  || kr<l  = maxBound
       | kl<=l && r<=kr = v
       | otherwise = go lt `min` go rt
     go (Leaf _ k v )
       | kl<=k && k<=kr = v
       | otherwise = maxBound

queryMax :: Int -> Int -> SegTree -> Int
queryMax kl kr segtree = go segtree
   where
     go (Node flg l r _ v lt rt)
       | r<kl  || kr<l  = minBound
       | kl<=l && r<=kr = v
       | otherwise = go lt `max` go rt
     go (Leaf _ k v )
       | kl<=k && k<=kr = v
       | otherwise = minBound

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

import Control.Applicative
import Data.Array.Base
import qualified Data.ByteString.Char8 as B
import Data.List

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

main = do
  [n,m] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map (\flg -> if flg then "Yes" else "No") $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Bool]
solve n _ qs | n<=2 = replicate (length qs `div` 2) True
solve n xs qs = go qs
   where
     !arr = listArray (0,n-2) $ zipWith (-) (tail xs) xs :: UArray Int Int
     !segtree = mkSegTree 0 (n-2) arr
     go (l:r:rest) = query (l-1) (r-2) segtree : go rest
     go _ = []

data SegTree = Node !Bool !Int !Int !Int !Int !SegTree !SegTree
             | Leaf !Bool !Int !Int

getMin :: SegTree -> Int
getMin (Node _ _ _ val _ _ _) = val
getMin (Leaf _ _ val )        = val

getMax :: SegTree -> Int
getMax (Node _ _ _ _ val _ _) = val
getMax (Leaf _ _ val )        = val

getFlg :: SegTree -> Bool
getFlg (Node flg _ _ _ _ _ _) = flg
getFlg (Leaf flg _ _ ) = flg

mkSegTree :: Int -> Int -> UArray Int Int -> SegTree
mkSegTree l r arr
  | l/=r = do
      let !m = (l+r) `quot` 2
          lt = mkSegTree l m arr
          rt = mkSegTree (m+1) r arr
      if getFlg lt && getFlg rt
         then if getMin lt < 0 && 0 < getMax rt
                 then Node False l r (min (getMin lt) (getMin rt)) (max (getMax lt) (getMax rt)) lt rt
                 else Node True  l r (min (getMin lt) (getMin rt)) (max (getMax lt) (getMax rt)) lt rt
         else Node False l r (min (getMin lt) (getMin rt)) (max (getMax lt) (getMax rt)) lt rt
  | otherwise = Leaf True l (unsafeAt arr l)

query :: Int -> Int -> SegTree -> Bool
query kl kr segtree = if kl>=kr then True else go segtree
   where
     go (Node flg l r v _ lt rt)
       | r<kl  || kr<l  = True
       | kl<=l && r<=kr = flg
       | otherwise = (queryMin kl kr lt >= 0 || queryMax kl kr rt <= 0) && go lt && go rt
     go (Leaf _ _ _ ) = True

queryMin :: Int -> Int -> SegTree -> Int
queryMin kl kr segtree = go segtree
   where
     go (Node flg l r v _ lt rt)
       | r<kl  || kr<l  = maxBound
       | kl<=l && r<=kr = v
       | otherwise = go lt `min` go rt
     go (Leaf _ _ v ) = v

queryMax :: Int -> Int -> SegTree -> Int
queryMax kl kr segtree = go segtree
   where
     go (Node flg l r _ v lt rt)
       | r<kl  || kr<l  = minBound
       | kl<=l && r<=kr = v
       | otherwise = go lt `max` go rt
     go (Leaf _ _ v ) = v


Twilight Sparkle once got a crystal from the Crystal Mine. A crystal of size n (n is odd; n > 1) is an n × n matrix with a diamond inscribed into it.You are given an odd integer n. You need to draw a crystal of size n. The diamond cells of the matrix should be represented by character "D". All other cells of the matrix should be represented by character "*". Look at the examples to understand what you need to draw.

The only line contains an integer n (3 ≤ n ≤ 101; n is odd).

***D***
**DDD**
*DDDDD*
DDDDDDD
*DDDDD*
**DDD**
***D***

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

main :: IO ()
main = interact $ unlines . solve . read

solve :: Int -> [String]
solve n = [l | x <- [1..n], let l = out x n]

out :: Int -> Int -> String
out i n
        | i*2-1 > n = out (n+1-i) n
        | otherwise =
            let
              p = i*2-1
              q = (n-p) `div` 2
            in
              replicate q '*' ++ replicate p 'D' ++ replicate q '*'

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

main :: IO ()
main = interact $ unlines . solve . read

solve :: Int -> [String]
solve n = [out i n | i <- [1..n]]

out :: Int -> Int -> String
out i n
        | i*2-1 > n = out (n+1-i) n
        | otherwise =
            let
              p = i*2-1
              q = (n-p) `div` 2
            in
              replicate q '*' ++ replicate p 'D' ++ replicate q '*'

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = do
  (line:_) <- fmap LC.words LC.getContents
  let n = readInt line
  putStr $ unlines $ out 1 (n `div` 2 + 1) n

out :: Int -> Int -> Int -> [String]
out _ _ 0 = []
out i n k =
          let
            j = if i < k then i+1 else i-1
          in
            (replicate (n-i) '*' ++ replicate (i*2-1) 'D' ++ replicate (n-i) '*') : out j n (k-1)

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

readInt :: LC.ByteString -> Int
readInt = LC.foldl' (\x c -> 10 * x + fromEnum c - 48) 0

main = do
	n<-getLine
	let res1 = solve (read n) 1
	let res2 = init $ unlines $reverse $ init $ lines res1
	putStr $ res1
	putStrLn res2

solve n l | l <=n = spaces ((n-l)) ++ printer (generator l) ++ spaces ((n-l))++ "\n" ++ solve n (l+2)
          | otherwise = ""

generator n =  replicate (n) "D"

spaces n = replicate (div n 2) '*'

printer s =  concat $  map (\x->  x ++ "") s

import Data.List

main = putStrLn . unlines . solve . read =<< getLine

solve :: Int -> [String]
solve n = solve' 1 True
    where solve' :: Int -> Bool -> [String]
          solve' x inc | x < 0 = []
                       | x > n = solve' (x - 4) False
                       | otherwise = let f = div (n - x) 2
                                         s = (replicate f '*') ++ (replicate x 'D') ++ (replicate f '*')
                                     in if inc
                                        then s:solve' (x + 2) inc
                                        else s:solve' (x - 2) inc

import Data.List
import Data.Function
import Data.Char

main = interact $ unlines . getAns . read

getAns :: Int -> [String]
getAns n = do
	x <- [1..n]
	return (getL x n)

getL :: Int -> Int -> String
getL x n
	| x * 2 - 1 > n = getL (n + 1 - x) n
	| otherwise = let a = x * 2 - 1; b = (n - a) `div` 2
				  in replicate b '*' ++ replicate a 'D' ++ replicate b '*'

{-# 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
  n <- readLn

  let
    s = [[f i j | j <- [1..n]] | i <- [1..n]]
    f i j = if abs (i-c) + abs (j-c) <= n`div`2 then 'D' else '*'
      where
        c = n`div`2+1

  putStr $ unlines s

main = interact $ f . read
f n = unlines $ map (g $ div (n + 1) 2) [1..n]
g x y = star ++ diam ++ star
  where star = replicate ns '*'
        diam = replicate (x * 2 - 1 - 2 * ns) 'D'
        ns = abs $ x - y

import Data.List
mkLine n m = replicate m '*' ++ replicate (n-2*m) 'D' ++ replicate m '*'
mkAns n = map (mkLine n) ([n`div`2,n`div`2-1..0] ++ [1..n`div`2])
main = readLn >>= mapM_ putStrLn . mkAns

solve :: Int -> [String]
solve n  =  [getLine i | i <- [1..n]]
  where
    getLine i  =  [getChar i j | j <- [1..n]]
    getChar i j
      | abs (m - i) + abs (m - j) < m  =  'D'
      | otherwise  =  '*'
    m  =  n `div` 2 + 1

main :: IO()
main  =  readLn >>= mapM_ putStrLn . solve

s m = replicate m '*'
main = do
  n <- read `fmap` getLine
  let xs = [1,3..n] ++ [n-2,n-4..1]
      sol= [concat [s m,replicate i 'D',s m] | i <- xs
           , let m = (n-i)`div`2]
  putStr . unlines $ sol

import Data.List

rowSizes :: Int -> [Int]
rowSizes n = gradient ++ [n] ++ (reverse gradient)
    where gradient = takeWhile (/=n) $ iterate (+2) 1

renderRow :: Int -> Int -> String
renderRow n s = padding ++ (replicate s 'D') ++ padding
    where t = (n - s) `div` 2
          padding = replicate t '*'

solve :: Int -> String
solve n = unlines $ map (renderRow n) $ rowSizes n

main = interact $ solve . read

main = do
    n <- readLn :: IO Int
    putStr $ unlines $ map (gen n) ([1, 3 .. n] ++ [n - 2, n - 4 .. 1])
    where
        gen :: Int -> Int -> [Char]
        gen n x = out ++ (replicate x 'D') ++ out
            where out = replicate ((n - x) `div` 2) '*'

main :: IO ()
main = readLn >>= mapM_ putStrLn . solve

solve :: Int -> [String]
solve n = [ replicate (m - i) '*' ++ replicate (2 * i + 1) 'D'
         ++ replicate (m - i) '*' | i <- [0..m] ++ [m-1, m-2 .. 0] ]
  where m = n `div` 2

import Control.Monad (liftM2)
main = interact $ unlines . liftM2 map row peak . read
peak n = [1 .. h+1] ++ [h,h-1..1] where h = n `div` 2
row n k = g ++ replicate (2*k-1) 'D' ++ g
  where g = replicate ((n-2*k+1) `div` 2) '*'

s n=[[if abs(i-(n`div`2+1))+abs(j-(n`div`2+1))>n`div`2 then '*' else 'D'|j<-[1..n]]|i<-[1..n]]
main=interact$unlines.s.read

import Control.Applicative
import Data.List

process n = (reverse k) ++ [(replicate n 'D')] ++ k
	where k = [ replicate i '*' ++ replicate j 'D' ++ replicate i '*'| i<-[1..div n 2], let j = n-2*i]

main= do
	n<-  read  <$>getLine::IO Int
	putStrLn $ intercalate "\n" $ process n

process :: Int -> [[Char]]
process n
    | even n = undefined
    | otherwise = [[if n'-i' <= j && j <= n'+i' then 'D' else '*' | j <- [0..(n-1)]] | i <- [0..(n-1)], let i' = min i (n-1-i)]
    where n' = n `div` 2

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    putStrLn . unlines $ process n

main = do
    n <- fmap read getLine :: IO Int
    putStrLn $ f n n
f 0 n = ""
f m n = x ++ y ++ x ++ "\n" ++ (f (m - 1) n) where
    k = if 2*m-1<=n then 2*m-1 else 2*(n-m)+1
    x = [1..div (n-k) 2]>>"*"
    y = [1..k]>>"D"

f :: Int -> Int -> String
f s l | l <= s `quot` 2    = (replicate ((s `quot` 2) - l+1) '*') ++ (replicate (2*(l) -1) 'D') ++ (replicate ((s `quot` 2) - l+1) '*')
      | l == s `quot` 2 +1 = replicate s 'D'
      | otherwise          = f s (s-l+1)

main = do
  line <- getLine
  let num = read line :: Int
      lst = map (f num) [1..num]
  mapM putStrLn lst


You are given a sequence of $$$n$$$ integers $$$a_1, \, a_2, \, \dots, \, a_n$$$.Does there exist a sequence of $$$n$$$ integers $$$b_1, \, b_2, \, \dots, \, b_n$$$ such that the following property holds?  For each $$$1 \le i \le n$$$, there exist two (not necessarily distinct) indices $$$j$$$ and $$$k$$$ ($$$1 \le j, \, k \le n$$$) such that $$$a_i = b_j - b_k$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 20$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 10$$$). The second line of each test case contains the $$$n$$$ integers $$$a_1, \, \dots, \, a_n$$$ ($$$-10^5 \le a_i \le 10^5$$$).

For each test case, output a line containing YES if a sequence $$$b_1, \, \dots, \, b_n$$$ satisfying the required property exists, and NO otherwise.

NoteIn the first test case, the sequence $$$b = [-9, \, 2, \, 1, \, 3, \, -2]$$$ satisfies the property. Indeed, the following holds:   $$$a_1 = 4 = 2 - (-2) = b_2 - b_5$$$;  $$$a_2 = -7 = -9 - (-2) = b_1 - b_5$$$;  $$$a_3 = -1 = 1 - 2 = b_3 - b_2$$$;  $$$a_4 = 5 = 3 - (-2) = b_4 - b_5$$$;  $$$a_5 = 10 = 1 - (-9) = b_3 - b_1$$$. In the second test case, it is sufficient to choose $$$b = [0]$$$, since $$$a_1 = 0 = 0 - 0 = b_1 - b_1$$$.In the third test case, it is possible to show that no sequence $$$b$$$ of length $$$3$$$ satisfies the property.

import Control.Arrow ((>>>))
import Control.Monad (filterM)
import Data.Bool (bool)
import Data.List (group, sort)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> chunksOf 2
      >>> map (last >>> words >>> map read >>> solve >>> bool "No" "Yes")
      >>> unlines

solve :: [Int] -> Bool
solve =
  any ((> 1) . length) -- does any sum occur more than once?
    . group
    . sort
    . map sum -- subsequence sums
    . filterM (const [False, True]) -- all subsequences
    . sort
    . map abs

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Monad (filterM, guard, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort, delete)
import Data.Maybe (fromJust, fromMaybe)
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = maybe "Yes" (const "No") . solve <$> numberOf int

-- Nothing -> Yes, Just () -> No
solve :: [Int] -> Maybe ()
solve xs = do
  xs <- pure $ sort (map abs xs)
  yesIf $ 0 `elem` xs
  yesIf $ any ((> 1) . length) $ group xs
  yesIf $ any ((> 1) . length) . group . sort $ subsums xs
  where
    yesIf = guard . not
    subseq = filterM (const [False, True])
    subsums = map sum . subseq

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

debug a = trace (show a) a

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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

import Control.Monad

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    let go [] 0     = 1
        go [] _     = 0
        go (x:xs) s = go xs s + go xs (s + x) + go xs (s - x)
    putStrLn $ if go a 0 > 1 then "YES" else "NO"

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- map abs <$> readInts
    let  opts = sort $ map (foldl' (+) 0) $ subsequences a
    --forM_ (subsequences a) putInts
    lift $ putStrLn $ if  any (uncurry (==)) $ zip opts $ tail opts
      then  "YES"
      else  "NO"

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Recently, Polycarp completed $$$n$$$ successive tasks.For each completed task, the time $$$s_i$$$ is known when it was given, no two tasks were given at the same time. Also given is the time $$$f_i$$$ when the task was completed. For each task, there is an unknown value $$$d_i$$$ ($$$d_i>0$$$) — duration of task execution.It is known that the tasks were completed in the order in which they came. Polycarp performed the tasks as follows:  As soon as the very first task came, Polycarp immediately began to carry it out.  If a new task arrived before Polycarp finished the previous one, he put the new task at the end of the queue.  When Polycarp finished executing the next task and the queue was not empty, he immediately took a new task from the head of the queue (if the queue is empty — he just waited for the next task). Find $$$d_i$$$ (duration) of each task.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The descriptions of the input data sets follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$). The second line of each test case contains exactly $$$n$$$ integers $$$s_1 < s_2 < \dots < s_n$$$ ($$$0 \le s_i \le 10^9$$$). The third line of each test case contains exactly $$$n$$$ integers $$$f_1 < f_2 < \dots < f_n$$$ ($$$s_i < f_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each of $$$t$$$ test cases print $$$n$$$ positive integers $$$d_1, d_2, \dots, d_n$$$ — the duration of each task.

NoteFirst test case:The queue is empty at the beginning: $$$[ ]$$$. And that's where the first task comes in. At time $$$2$$$, Polycarp finishes doing the first task, so the duration of the first task is $$$2$$$. The queue is empty so Polycarp is just waiting.At time $$$3$$$, the second task arrives. And at time $$$7$$$, the third task arrives, and now the queue looks like this: $$$[7]$$$.At the time $$$10$$$, Polycarp finishes doing the second task, as a result, the duration of the second task is $$$7$$$.And at time $$$10$$$, Polycarp immediately starts doing the third task and finishes at time $$$11$$$. As a result, the duration of the third task is $$$1$$$.    An example of the first test case.

import Data.Int

ans :: IO String
ans = do
 n <- readLn :: IO Int
 input <- getLine
 let s = [read x :: Int32 | x <- words input]
 input <- getLine
 let f = [read x :: Int32 | x <- words input]
 let maxs = [max (fst x) (snd x) | x <- zip (tail s) f]
 let results = (head f - head s) : [(fst x) - (snd x) | x <- zip (tail f) maxs]
 return $ unwords [show x | x <- results]

main :: IO ()
main = do
 t <- readLn :: IO Int
 results <- sequence $ replicate t ans
 putStrLn $ unlines results

ans :: IO String
ans = do
 n <- readLn :: IO Int
 input <- getLine
 let s = [read x :: Int | x <- words input]
 input <- getLine
 let f = [read x :: Int | x <- words input]
 let maxs = [max (fst x) (snd x) | x <- zip (tail s) f]
 let results = (head f - head s) : [(fst x) - (snd x) | x <- zip (tail f) maxs]
 return $ unwords [show x | x <- results]

main :: IO ()
main = do
 t <- readLn :: IO Int
 results <- sequence $ replicate t ans
 putStrLn $ unlines results

ans :: IO String
ans = do
 n <- readLn :: IO Int
 sInput <- getLine
 fInput <- getLine
 let s = [read x :: Int | x <- words sInput]
 let f = [read x :: Int | x <- words fInput]
 let maxs = [max (fst x) (snd x) | x <- zip (tail s) f]
 let results = (head f - head s) : [(fst x) - (snd x) | x <- zip (tail f) maxs]
 return $ unwords [show x | x <- results]

main :: IO ()
main = do
 t <- readLn :: IO Int
 results <- sequence $ replicate t ans
 putStrLn $ unlines results

calc' :: [Int] -> [Int] -> Int -> [Int]
calc' [] [y] later = [y - later]
calc' (x : xs) (y : ys) later = [y - later] ++ calc' xs ys (max y x)

calc :: [Int] -> [Int] -> [Int]
calc [x] [y] = [y - x]
calc (x0 : x1 : xs) (y : ys) = [y - x0] ++ calc' xs ys (max y x1)

ans :: IO String
ans = do
 n <- readLn :: IO Int
 sInput <- getLine
 fInput <- getLine
 let s = [read x :: Int | x <- words sInput]
 let f = [read x :: Int | x <- words fInput]
 let results = calc s f
 return $ unwords [show x | x <- results]

main :: IO ()
main = do
 t <- readLn :: IO Int
 results <- sequence $ replicate t ans
 putStrLn $ unlines results

calc' :: [Int] -> [Int] -> Int -> [Int]
calc' [_] [y] later = [y - later]
calc' (_ : x : xs) (y : ys) later = [y - later] ++ calc' (x : xs) ys (max y x)

calc :: [Int] -> [Int] -> [Int]
calc [x] [y] = [y - x]
calc (x : xs) (y : ys) = [y - x] ++ calc' xs ys (max y $ head xs)

ans :: IO String
ans = do
 n <- readLn :: IO Int
 sInput <- getLine
 fInput <- getLine
 let s = [read x :: Int | x <- words sInput]
 let f = [read x :: Int | x <- words fInput]
 let results = calc s f
 return $ unwords [show x | x <- results]

main :: IO ()
main = do
 t <- readLn :: IO Int
 results <- sequence $ replicate t ans
 putStrLn $ unlines results

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 (_:x:y:xs) = (x,y):(sep xs)

parse (x,y) = (phi x, phi y)
  where phi = (map read) . words

format = unwords . map show

solve (ss,fs) = solve' 0 ss fs

solve' _ [] [] = []
solve' f0 (s:ss) (f:fs) = (f - max s f0):(solve' f ss fs)

-- 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
    aa  <- getInts
    bb  <- getInts

    let f a z b = b - max a z
    let dd = zipWith3 f aa (0:bb) bb
    putShows dd


Ivan is playing a strange game.He has a matrix a with n rows and m columns. Each element of the matrix is equal to either 0 or 1. Rows and columns are 1-indexed. Ivan can replace any number of ones in this matrix with zeroes. After that, his score in the game will be calculated as follows:  Initially Ivan's score is 0;  In each column, Ivan will find the topmost 1 (that is, if the current column is j, then he will find minimum i such that ai, j = 1). If there are no 1's in the column, this column is skipped;  Ivan will look at the next min(k, n - i + 1) elements in this column (starting from the element he found) and count the number of 1's among these elements. This number will be added to his score. Of course, Ivan wants to maximize his score in this strange game. Also he doesn't want to change many elements, so he will replace the minimum possible number of ones with zeroes. Help him to determine the maximum possible score he can get and the minimum possible number of replacements required to achieve that score.

The first line contains three integer numbers n, m and k (1 ≤ k ≤ n ≤ 100, 1 ≤ m ≤ 100). Then n lines follow, i-th of them contains m integer numbers — the elements of i-th row of matrix a. Each number is either 0 or 1.

Print two numbers: the maximum possible score Ivan can get and the minimum number of replacements required to get this score.

NoteIn the first example Ivan will replace the element a1, 2.

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

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  (\(a, b) -> show a ++ " " ++ show b) `fmap` liftM2 solve poi (replicateM n $ replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k = foldl (\(!a, !b) (a', b') -> (a' + a, b' + b)) (0, 0) . map (col k) . transpose

col :: Int -> [Int] -> (Int, Int)
col k xs =  maximumBy (compare `on` fst) $ reverse $ zipWith (\i i' -> (i' - i, i)) os (drop k os)
  where os = scanl (+) 0 xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Char

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  (\(a, b) -> show a ++ " " ++ show b) `fmap` liftM2 solve poi (replicateM n $ (B.pack . map intToDigit) `fmap` replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k = foldl (\(!a, !b) (a', b') -> (a' + a, b' + b)) (0, 0) . map (((\l -> (\(f, s) -> (B.count '1' $ B.take (fromIntegral k) $ B.concat s, B.count '1' $ B.concat f)). span ((/= l) . min (fromIntegral k) . B.length)) =<< (maximum . (0:) . map (min (fromIntegral k) . B.length) . filter ((== '1') . B.head))) . B.group) . B.transpose

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Char

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  (\(a, b) -> show a ++ " " ++ show b) `fmap` liftM2 solve poi (replicateM n $ (B.pack . map intToDigit) `fmap` replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k = foldl (\(!a, !b) (a', b') -> (a' + a, b' + b)) (0, 0) . map (((\l -> (\(f, s) -> (B.count '1' $ B.take (fromIntegral k) $ B.concat s, B.count '1' $ B.concat f)). span (\xs -> B.head xs == '0' || min (fromIntegral k) (B.length xs) /= l )) =<< (maximum . (0:) . map (min (fromIntegral k) . B.length) . filter ((== '1') . B.head))) . B.group) . B.transpose

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Char

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  (\(a, b) -> show a ++ " " ++ show b) `fmap` liftM2 solve poi (replicateM n $ (B.pack . map intToDigit) `fmap` replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k = foldl (\(!a, !b) (a', b') -> (a' + a, b' + b)) (0, 0) . map (((\l -> (min k $ fromIntegral l,) . B.count '1' . B.concat . takeWhile ((/= l) . min (fromIntegral k) . B.length)) =<< (maximum . (0:) . map (min (fromIntegral k) . B.length) . filter ((== '1') . B.head))) . B.group) . B.transpose

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Char

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  (\(a, b) -> show a ++ " " ++ show b) `fmap` liftM2 solve poi (replicateM n $ (B.pack . map intToDigit) `fmap` replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k = foldl (\(!a, !b) (a', b') -> (a' + a, b' + b)) (0, 0) . map (((\l -> (min k $ fromIntegral l,) . B.count '1' . B.concat . takeWhile ((/= l) . B.length)) =<< (maximum . (0:) . map B.length . filter ((== '1') . B.head))) . B.group) . B.transpose


Vasya came up with a password to register for EatForces — a string $$$s$$$. The password in EatForces should be a string, consisting of lowercase and uppercase Latin letters and digits.But since EatForces takes care of the security of its users, user passwords must contain at least one digit, at least one uppercase Latin letter and at least one lowercase Latin letter. For example, the passwords "abaCABA12", "Z7q" and "3R24m" are valid, and the passwords "qwerty", "qwerty12345" and "Password" are not. A substring of string $$$s$$$ is a string $$$x = s_l s_{l + 1} \dots s_{l + len - 1} (1 \le l \le |s|, 0 \le len \le |s| - l + 1)$$$. $$$len$$$ is the length of the substring. Note that the empty string is also considered a substring of $$$s$$$, it has the length $$$0$$$.Vasya's password, however, may come too weak for the security settings of EatForces. He likes his password, so he wants to replace some its substring with another string of the same length in order to satisfy the above conditions. This operation should be performed exactly once, and the chosen string should have the minimal possible length.Note that the length of $$$s$$$ should not change after the replacement of the substring, and the string itself should contain only lowercase and uppercase Latin letters and digits.

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of testcases. Each of the next $$$T$$$ lines contains the initial password $$$s~(3 \le |s| \le 100)$$$, consisting of lowercase and uppercase Latin letters and digits. Only $$$T = 1$$$ is allowed for hacks.

For each testcase print a renewed password, which corresponds to given conditions.  The length of the replaced substring is calculated as following: write down all the changed positions. If there are none, then the length is $$$0$$$. Otherwise the length is the difference between the first and the last changed position plus one. For example, the length of the changed substring between the passwords "abcdef" $$$\rightarrow$$$ "a7cdEf" is $$$4$$$, because the changed positions are $$$2$$$ and $$$5$$$, thus $$$(5 - 2) + 1 = 4$$$. It is guaranteed that such a password always exists. If there are several suitable passwords — output any of them.

NoteIn the first example Vasya's password lacks a digit, he replaces substring "C" with "4" and gets password "abcD4E". That means, he changed the substring of length 1.In the second example Vasya's password is ok from the beginning, and nothing has to be changed. That is the same as replacing the empty substring with another empty substring (length 0).

{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Text.Printf
import Data.Char

readIntBS = fst . fromJust . BS.readInt

main = do
  n <- readLn :: IO Int

  replicateM n $ do
    s <- getLine

    let
      cntDig = length $ filter isDigit s
      cntUpp = length $ filter isUpper s
      cntLow = length $ filter isLower s
      cntSum = cntDig + cntUpp + cntLow

      replace i x xs = let (a,b) = splitAt i xs in a ++ (x : (tail b))

    if
      | cntDig > 0 && cntUpp > 0 && cntLow > 0 -> putStrLn s
      | cntSum == cntDig -> putStrLn $ 'a' : 'A' : (tail $ tail s)
      | cntSum == cntUpp -> putStrLn $ 'a' : '1' : (tail $ tail s)
      | cntSum == cntLow -> putStrLn $ 'A' : '1' : (tail $ tail s)
      | cntDig == 0 -> putStrLn $ let Just i = findIndex (if cntUpp >= cntLow then isUpper else isLower) s in replace i '1' s
      | cntUpp == 0 -> putStrLn $ let Just i = findIndex (if cntDig >= cntLow then isDigit else isLower) s in replace i 'A' s
      | cntLow == 0 -> putStrLn $ let Just i = findIndex (if cntUpp >= cntDig then isUpper else isDigit) s in replace i 'a' s


Given a permutation $$$p$$$ of length $$$n$$$, find its subsequence $$$s_1$$$, $$$s_2$$$, $$$\ldots$$$, $$$s_k$$$ of length at least $$$2$$$ such that:  $$$|s_1-s_2|+|s_2-s_3|+\ldots+|s_{k-1}-s_k|$$$ is as big as possible over all subsequences of $$$p$$$ with length at least $$$2$$$.  Among all such subsequences, choose the one whose length, $$$k$$$, is as small as possible. If multiple subsequences satisfy these conditions, you are allowed to find any of them.A sequence $$$a$$$ is a subsequence of an array $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deleting some (possibly, zero or all) elements.A permutation of length $$$n$$$ is an array of length $$$n$$$ in which every element from $$$1$$$ to $$$n$$$ occurs exactly once.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the length of the permutation $$$p$$$. The second line of each test case contains $$$n$$$ integers $$$p_1$$$, $$$p_2$$$, $$$\ldots$$$, $$$p_{n}$$$ ($$$1 \le p_i \le n$$$, $$$p_i$$$ are distinct) — the elements of the permutation $$$p$$$. The sum of $$$n$$$ across the test cases doesn't exceed $$$10^5$$$.

For each test case, the first line should contain the length of the found subsequence, $$$k$$$. The second line should contain $$$s_1$$$, $$$s_2$$$, $$$\ldots$$$, $$$s_k$$$ — its elements. If multiple subsequences satisfy these conditions, you are allowed to find any of them.

NoteIn the first test case, there are $$$4$$$ subsequences of length at least $$$2$$$:  $$$[3,2]$$$ which gives us $$$|3-2|=1$$$.  $$$[3,1]$$$ which gives us $$$|3-1|=2$$$.  $$$[2,1]$$$ which gives us $$$|2-1|=1$$$.  $$$[3,2,1]$$$ which gives us $$$|3-2|+|2-1|=2$$$. So the answer is either $$$[3,1]$$$ or $$$[3,2,1]$$$. Since we want the subsequence to be as short as possible, the answer is $$$[3,1]$$$.

import Control.Monad

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

routine :: IO ()
routine = do
  _ <- getLine
  xs <- (map read.words) <$> getLine
  let (a,as) = solve xs
  print a
  putStrLn $ (unwords.map show) as

f :: [Int] -> [Int]
f (x:y:z:xs)
  | (x < y && y < z) || (x > y && y > z ) = f (x:z:xs)
  | otherwise = x: f (y:z:xs)
f a = a

solve :: [Int] -> (Int,[Int])
solve xs = let r = f xs in (length r, r)