One day a well-known sponsor of a well-known contest decided to give every participant of the contest a T-shirt as a present. A natural problem occurred: on the one hand, it is not clear how many T-shirts of what sizes should be ordered, and on the other hand, one doesn't want to order too many T-shirts (and we do not exactly paper the walls with the oversupply). After considerable brain racking and some pre-estimating, the sponsor representatives ordered a certain number of T-shirts of sizes S, M, L, XL and XXL. The T-shirts turned out to bring good luck, that's why on the contest day there built up a line of K participants willing to get one. Every contestant is characterized by his/her desired T-shirt size (so it happens that for all the participants it is also one of the sizes S, M, L, XL and XXL). The participants come up to get a T-shirt one by one and try to choose the most suitable one, choosing it like this. If there is still a T-shirt of the optimal size left, that he/she takes it without further ado. Otherwise the contestant would prefer to choose a T-shirt with the size as close to the optimal one as possible (the distance between neighboring sizes is considered equal to one). If the variant of choice is not unique, the contestant will take a T-shirt of a bigger size (in case he/she grows more). For example, for a person whose optimal size is L the preference list looks like this: L, XL, M, XXL, S. Using the data on how many T-shirts of every size had been ordered by the organizers, on the size of contestants in the line determine who got a T-shirt of what size.

The first line contains five non-negative integers NS, NM, NL, NXL, NXXL not exceeding 1000 which represent the number of T-shirts of the corresponding sizes. The second line contains an integer K (1 ≤ K ≤ 1000) which represents the number of participants. The next K lines contain the optimal T-shirt sizes for the contestants. The sizes are given in the order in which the participants stand in the line. It is guaranteed that NS + NM + NL + NXL + NXXL ≥ K.

For each contestant, print a line containing the size of the T-shirt he/she got.

import Data.Map
main = interact (unlines.sol.words)
sol (s:m:l:xl:xxl:n:xs) = sol' sz (take (read n) xs) [] where
    sz = fromList [("S",read s),("M",read m),("L",read l),("XL",read xl),("XXL",read xxl)]
    sol' sz []     acc = reverse acc
    sol' sz (x:xs) acc = sol' (adjust pred k sz) xs (k:acc) where
        k = k' (ks!x) where k' (k:f) = if sz!k>0 then k else k' f
ks = fromList [("S",["S","M","L","XL","XXL"]),("M",["M","L","S","XL","XXL"]),("L",["L","XL","M","XXL","S"]),("XL",["XL","XXL","L","M","S"]),("XXL",["XXL","XL","L","M","S"])]

solve :: Int -> Int -> Int -> Int -> Int -> [String] -> [String]
solve _ _ _ _ _ []  =  []
solve nS nM nL nXL nXXL ("S":xs)
  | nS > 0  =  "S" : solve (nS-1) nM nL nXL nXXL xs
  | nM > 0  =  "M" : solve nS (nM-1) nL nXL nXXL xs
  | nL > 0  =  "L" : solve nS nM (nL-1) nXL nXXL xs
  | nXL > 0  =  "XL" : solve nS nM nL (nXL-1) nXXL xs
  | nXXL > 0  =  "XXL" : solve nS nM nL nXL (nXXL-1) xs
solve nS nM nL nXL nXXL ("M":xs)
  | nM > 0  =  "M" : solve nS (nM-1) nL nXL nXXL xs
  | nL > 0  =  "L" : solve nS nM (nL-1) nXL nXXL xs
  | nS > 0  =  "S" : solve (nS-1) nM nL nXL nXXL xs
  | nXL > 0  =  "XL" : solve nS nM nL (nXL-1) nXXL xs
  | nXXL > 0  =  "XXL" : solve nS nM nL nXL (nXXL-1) xs
solve nS nM nL nXL nXXL ("L":xs)
  | nL > 0  =  "L" : solve nS nM (nL-1) nXL nXXL xs
  | nXL > 0  =  "XL" : solve nS nM nL (nXL-1) nXXL xs
  | nM > 0  =  "M" : solve nS (nM-1) nL nXL nXXL xs
  | nXXL > 0  =  "XXL" : solve nS nM nL nXL (nXXL-1) xs
  | nS > 0  =  "S" : solve (nS-1) nM nL nXL nXXL xs
solve nS nM nL nXL nXXL ("XL":xs)
  | nXL > 0  =  "XL" : solve nS nM nL (nXL-1) nXXL xs
  | nXXL > 0  =  "XXL" : solve nS nM nL nXL (nXXL-1) xs
  | nL > 0  =  "L" : solve nS nM (nL-1) nXL nXXL xs
  | nM > 0  =  "M" : solve nS (nM-1) nL nXL nXXL xs
  | nS > 0  =  "S" : solve (nS-1) nM nL nXL nXXL xs
solve nS nM nL nXL nXXL ("XXL":xs)
  | nXXL > 0  =  "XXL" : solve nS nM nL nXL (nXXL-1) xs
  | nXL > 0  =  "XL" : solve nS nM nL (nXL-1) nXXL xs
  | nL > 0  =  "L" : solve nS nM (nL-1) nXL nXXL xs
  | nM > 0  =  "M" : solve nS (nM-1) nL nXL nXXL xs
  | nS > 0  =  "S" : solve (nS-1) nM nL nXL nXXL xs

main :: IO ()
main  =  do
    [nS, nM, nL, nXL, nXXL]  <-  getLine >>= return . map read . words
    n  <-  readLn
    xs  <-  getContents >>= return . take n . lines
    mapM_ putStrLn $ solve nS nM nL nXL nXXL xs

import Data.Map (Map)
import qualified Data.Map as Map
import Maybe
main = interact solve
solve input = output where
  ns = map (read::String->Int) $ words $ head $ lines input
  opt = map s2i $ drop 2 $ lines input
  output = unlines $ map i2s $ answer (num ns) opt
size = ["S","M","L","XL","XXL"]
s2i x = fromJust $ lookup x $ zip size [1..5]
i2s x = size!!(x-1)
num xs = Map.fromList $ zip [1..5] xs
pre = Map.fromList $ zip [1..5]
  [[1,2,3,4,5],[2,3,1,4,5],[3,4,2,5,1],[4,5,3,2,1],[5,4,3,2,1]]
answer :: Map Int Int -> [Int] -> [Int]
answer _ [] = []
answer xs (y:ys) = x : ( answer (Map.adjust (\z->z-1) x xs) ys ) where
  x = choice xs (fromJust $ Map.lookup y pre)
choice :: Map Int Int -> [Int] -> Int
choice _ [] = 0
choice xs (y:ys) = if (fromJust $ Map.lookup y xs)==0 then choice xs ys else y


You have a garden consisting entirely of grass and weeds. Your garden is described by an n × m grid, with rows numbered 1 to n from top to bottom, and columns 1 to m from left to right. Each cell is identified by a pair (r, c) which means that the cell is located at row r and column c. Each cell may contain either grass or weeds. For example, a 4 × 5 garden may look as follows (empty cells denote grass):  You have a land-mower with you to mow all the weeds. Initially, you are standing with your lawnmower at the top-left corner of the garden. That is, at cell (1, 1). At any moment of time you are facing a certain direction — either left or right. And initially, you face right.In one move you can do either one of these:1) Move one cell in the direction that you are facing.  if you are facing right: move from cell (r, c) to cell (r, c + 1)     if you are facing left: move from cell (r, c) to cell (r, c - 1)    2) Move one cell down (that is, from cell (r, c) to cell (r + 1, c)), and change your direction to the opposite one.  if you were facing right previously, you will face left     if you were facing left previously, you will face right    You are not allowed to leave the garden. Weeds will be mowed if you and your lawnmower are standing at the cell containing the weeds (your direction doesn't matter). This action isn't counted as a move.What is the minimum number of moves required to mow all the weeds?

The first line contains two integers n and m (1 ≤ n, m ≤ 150) — the number of rows and columns respectively. Then follow n lines containing m characters each — the content of the grid. "G" means that this cell contains grass. "W" means that this cell contains weeds.  It is guaranteed that the top-left corner of the grid will contain grass.

Print a single number — the minimum number of moves required to mow all the weeds.

NoteFor the first example, this is the picture of the initial state of the grid:  A possible solution is by mowing the weeds as illustrated below:

module Main where

import Data.List
import Control.Monad

data Dir = LEFT | RIGHT deriving (Show, Eq)

main = do
    [n, m] <- getLine >>= return . map read . words :: IO [Int]

    boards <- replicateM n getLine
    let pivots = map (\l -> if null l then Nothing else Just (head l, last l)) $ map (elemIndices 'W') boards
        (cursor, cost, dir, skip) = foldl' (\(cursor, cost, dir, skip) pivot ->
                let dir' = case dir of
                        LEFT -> RIGHT
                        RIGHT -> LEFT
                in case pivot of
                    Nothing -> (cursor, cost, dir', skip+1)
                    Just (l, r) -> case dir of
                        LEFT -> if cursor <= l
                            then (r, cost+skip+r-cursor, dir', 1)
                            else (r, cost+skip+cursor-l+r-l, dir', 1)
                        RIGHT -> if cursor >= r
                            then (l, cost+skip+cursor-l, dir', 1)
                            else (l, cost+skip+r-cursor+r-l, dir', 1)
            ) (0, 0, LEFT, 0) pivots

    --putStrLn $ show pivots
    --putStrLn $ show (cursor, cost, dir, skip)
    putStrLn $ show cost

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

last' l = case (C.elemIndex 'W' . C.reverse) l of
	Nothing -> 0
	Just x -> C.length l - 1 - x
fst' l = case C.elemIndex 'W' l of
	Nothing -> 0
	Just x -> C.length l - 1 - x

solve [] _ = 0
solve [ln] i = max 0 (last' ln - i)
	where n = C.length ln
solve (ln1:ln2:lns) i = let j = max 0 (max (last' ln1) (fst' ln2) - i) in let next = solve (ln2:lns) (n - j - i - 1) in j + next + 1
	where n = C.length ln1

halfrev lns = [if i `mod` 2 == 1 then C.reverse (lns !! i) else (lns !! i) | i <- [0..n-1]]
	where n = length lns

tailcut [] = []
tailcut (x:xs)
	| tailcut xs == [] && C.elemIndex 'W' x == Nothing = []
	| otherwise = (x:tailcut xs)

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, m] = map (fst . fromJust . C.readInt) . C.words $ head input
	let view = take n $ tail input
	putStrLn . show $ solve (tailcut $ halfrev view) 0

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    m <- readInt
    grid <- replicateM n (BS.unpack <$> readString)
    return (n, m, grid)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

inf = 10^9

solve (n, m, grid) = go (0 : replicate (m-1) inf) True weeds' - 1
  where
    weeds = [ indices
            | (i, row) <- zip [0..] grid
            , let indices = elemIndices 'W' row ++ [0 | i == 0]
            ]

    weeds' = reverse $ dropWhile null $ reverse weeds

    go prev right [] = minimum prev
    go prev right (row:rows) = go end' (not right) rows
      where
        minv = if null row then inf else minimum row
        maxv = if null row then -inf else maximum row

        start = [if right && i > minv || not right && i < maxv then inf else ri + 1 | (i, ri) <- zip [0..] prev]
        end
            | right     = scanl1 (\v x -> (v + 1) `min` x) start
            | otherwise = scanr1 (\x v -> (v + 1) `min` x) start
        end' = [if right && i < maxv || not right && i > minv then inf else min inf ri | (i, ri) <- zip [0..] end]

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Data.Maybe
q l|null l=Nothing|1>0=Just(head l,last l)
p=q.map fst.filter((=='W').snd).zip[0..]

sr dir i []=(-1)
sr dir i (Nothing:t)=1+sr (-dir) i t
sr 1 i (Just(l,r):t)=1+2*b+f+sr (-1) j t where
  b|i>l=i-l
   |1>0=0
  (f,j)=(r-i,r)
sr (-1) i (Just(l,r):t)=1+2*b+f+sr 1 j t where
  b|i<r=r-i
   |1>0=0
  (f,j)=(i-l,l)

dn (Nothing:h:t) = dn (h:t)
dn l = l

main=interact$show.sr 1 0.reverse.dn.reverse.map p.tail.lines

{-# OPTIONS -O2 #-}
import Data.List

main = do
  s <- getContents
  let
    (grid:ls) = lines s
    [row, col] = map read $ words grid :: [Int]
    ws' = [(i+1, j+1) |i<-[0..row-1], j<-[0..col-1], (ls !! i) !! j == 'W']
    ws = [(r, (minimum [x|(y,x)<-ws', y==r], maximum [x|(y,x)<-ws', y==r])) | r <- [1..row], elem 'W' (ls !! (r-1))]
  print $ search 1 1 ws

search _ _ [] = 0
search row column orig@[(r, (a, b))]
  | row == r = dist goalPos'
  | row + 1 == r = dist goalPos' + 1 + search (row+1) goalPos' orig
  | otherwise = 1 + search (row+1) column orig
  where
    dist x = abs $ x - column
    goalPos' = if mod row 2 == 0 then a else b

search row column orig@((r, (a, b)):(r', (a', b')):l)
  | row == r && row + 1 == r' = dist goalPos + 1 + search (row+1) goalPos ((r', (a', b')):l)
  | row == r = dist goalPos' + 1 + search (row+1) goalPos' ((r', (a', b')):l)
  | row + 1 == r = dist goalPos' + 1 + search (row+1) goalPos' orig
  | otherwise = 1 + search (row+1) column orig
  where
    dist x = abs $ x - column
    goalPos = if mod row 2 == 0 then min a a' else max b b'
    goalPos' = if mod row 2 == 0 then a else b

import Data.List
import qualified Data.Map as Map
import Data.Map ((!))
import Control.Monad
import Control.Applicative
import Debug.Trace

traceS a b = trace (show a) b

type Z = Int

data Dir = L | R deriving Show

antiDir L = R
antiDir R = L

solve :: Z -> Z -> [String] -> Z
solve n m ls = solve' n m ls' 0 R
  where ls' = cutter ls

cutter ls = reverse $ cutter' (reverse ls)

cutter' [] = []
cutter' ls =
  case elemIndex 'W' l of
    Nothing -> cutter' lss
    Just _  -> ls
  where (l:lss) = ls

solve' _ _ [] _ _ = 0
solve' n m [l] c L = c - (elemFind c l)
solve' n m [l] c R = solve' n m [reverse l] (m-c-1) L
solve' n m (l1:lrem@(l2:ls)) c dir =
  abs (t-c) + solve' n m lrem t (antiDir dir) + 1
  where t = getTarget c m l1 l2 dir

getTarget c m l1 l2 L = min t1 t2
  where t1 = elemFind c l1
        t2 = elemFind c l2
getTarget c m l1 l2 R = m - (1 + getTarget (m-c-1) m (reverse l1) (reverse l2) L)

elemFind c l1 =
  case elemIndex 'W' l1 of
    Nothing -> c
    Just t1 -> min t1 c

main = do
  (n,m) <- (\[a,b] -> (a,b)) . map read . words <$> getLine
  ls <- replicateM n getLine
  print $ solve n m ls

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

last' l = case (C.elemIndex 'W' . C.reverse) l of
	Nothing -> -1
	Just x -> C.length l - 1 - x
fst' l = case C.elemIndex 'W' l of
	Nothing -> -1
	Just x -> C.length l - 1 - x

solve [] _ = -1
solve [ln] i = max (-1) (last' ln - i)
	where n = C.length ln
solve (ln1:ln2:lns) i = let j = max (last' ln1) (fst' ln2) in max (-1) (j - i) + solve (ln2:lns) (n - j - 1) + 1
	where n = C.length ln1

halfrev lns = [if i `mod` 2 == 1 then C.reverse (lns !! i) else (lns !! i) | i <- [0..n-1]]
	where n = length lns

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, m] = map (fst . fromJust . C.readInt) . C.words $ head input
	let view = take n $ tail input
	putStrLn . show . max 0 $ solve (halfrev view) 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

last' l = case (C.elemIndex 'W' . C.reverse) l of
	Nothing -> -1
	Just x -> C.length l - 1 - x
fst' l = case C.elemIndex 'W' l of
	Nothing -> -1
	Just x -> C.length l - 1 - x

solve [] _ = 0
solve [ln] i = max (-1) (last' ln - i)
	where n = C.length ln
solve (ln1:ln2:lns) i = let j = max (last' ln1) (fst' ln2) in let next = max (-1) (solve (ln2:lns) (n - j - 1)) in if next < 0 then max (-1) (j-i) else max 0 (j-i) + next + 1
	where n = C.length ln1

halfrev lns = [if i `mod` 2 == 1 then C.reverse (lns !! i) else (lns !! i) | i <- [0..n-1]]
	where n = length lns

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, m] = map (fst . fromJust . C.readInt) . C.words $ head input
	let view = take n $ tail input
	putStrLn . show . max 0 $ solve (halfrev view) 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

last' l = case (C.elemIndex 'W' . C.reverse) l of
	Nothing -> -1
	Just x -> C.length l - 1 - x
fst' l = case C.elemIndex 'W' l of
	Nothing -> -1
	Just x -> C.length l - 1 - x

solve [] _ = -1
solve [ln] i = max (-1) (last' ln - i)
	where n = C.length ln
solve (ln1:ln2:lns) i = let j = max (last' ln1) (fst' ln2) in max 0 (j - i) + solve (ln2:lns) (n - j - 1) + 1
	where n = C.length ln1

halfrev lns = [if i `mod` 2 == 1 then C.reverse (lns !! i) else (lns !! i) | i <- [0..n-1]]
	where n = length lns

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, m] = map (fst . fromJust . C.readInt) . C.words $ head input
	let view = take n $ tail input
	putStrLn . show . max 0 $ solve (halfrev view) 0

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    m <- readInt
    grid <- replicateM n (BS.unpack <$> readString)
    return (n, m, grid)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (n, m, grid) = go 0 True weeds - 1
  where
    weeds = [ sort indices
            | (i, row) <- zip [0..] grid
            , let indices = elemIndices 'W' row ++ [0 | i == 0]
            ]

    weeds' = reverse $ dropWhile null $ reverse weeds

    go _ _ [] = 0
    go p right ([] : rows) = go p (not right) rows + 1
    go p right (row : rows)
        | right     = (maximum row - l) + (p - l) + 1 + go (maximum row) (not right) rows
        | otherwise = (r - minimum row) + (r - p) + 1 + go (minimum row) (not right) rows
      where
        l = minimum row `min` p
        r = maximum row `max` p

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    m <- readInt
    grid <- replicateM n (BS.unpack <$> readString)
    return (n, m, grid)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

inf = 10^9

solve (n, m, grid) = go (0 : replicate (m-1) inf) True weeds - 1
  where
    weeds = [ indices
            | (i, row) <- zip [0..] grid
            , let indices = elemIndices 'W' row ++ [0 | i == 0]
            ]

    weeds' = reverse $ dropWhile null $ reverse weeds

    go prev right [] = minimum prev
    go prev right (row:rows) = go end' (not right) rows
      where
        minv = if null row then inf else minimum row
        maxv = if null row then -inf else maximum row

        start = [if right && i > minv || not right && i < maxv then inf else ri + 1 | (i, ri) <- zip [0..] prev]
        end
            | right     = scanl1 (\v x -> (v + 1) `min` x) start
            | otherwise = scanr1 (\x v -> (v + 1) `min` x) start
        end' = [if right && i < maxv || not right && i > minv then inf else min inf ri | (i, ri) <- zip [0..] end]

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

{-# OPTIONS -O2 #-}
import Data.List

main = do
  s <- getContents
  let
    (grid:ls) = lines s
    [row, col] = map read $ words grid :: [Int]
    ws' = [(i+1, j+1) |i<-[0..row-1], j<-[0..col-1], (ls !! i) !! j == 'W']
    ws = [(r, (minimum [x|(y,x)<-ws', y==r], maximum [x|(y,x)<-ws', y==r])) | r <- [1..row], elem 'W' (ls !! (r-1))]
  print $ search 1 1 ws

search _ _ [] = 0
search row column [(r, (a, b))]= if mod row 2 == 0 then column - a else b - column
search row column orig@((r, (a, b)):(r', (a', b')):l)
  | row == r && row + 1 == r' = dist goalPos + 1 + search (row+1) goalPos ((r', (a', b')):l)
  | row == r = dist goalPos' + 1 + search (row+1) goalPos' ((r', (a', b')):l)
  | row + 1 == r = dist goalPos' + 1 + search (row+1) goalPos' orig
  | otherwise = 1 + search (row+1) column orig
  where
    dist x = abs $ x - column
    goalPos = if mod row 2 == 0 then min a a' else max b b'
    goalPos' = if mod row 2 == 0 then a else b
    goalPos'' = if mod row 2 == 0 then b else a

{-# OPTIONS -O2 #-}
import Data.List

main = do
  s <- getContents
  let
    (grid:ls) = lines s
    [row, col] = map read $ words grid :: [Int]
    ws' = [(i+1, j+1) |i<-[0..row-1], j<-[0..col-1], (ls !! i) !! j == 'W']
    ws = [(r, (minimum [x|(y,x)<-ws', y==r], maximum [x|(y,x)<-ws', y==r])) | r <- [1..row], elem 'W' (ls !! (r-1))]
  print $ search 1 1 ws

search _ _ [] = 0
search row column [(r, (a, b))]= if mod row 2 == 0 then column - a else b - column
search row column orig@((r, (a, b)):(r', (a', b')):l)
  | row == r && row + 1 == r' = dist goalPos + 1 + search (row+1) goalPos ((r', (a', b')):l)
  | row == r = dist goalPos' + 1 + search (row+1) goalPos' ((r', (a', b')):l)
  | row + 1 == r = dist goalPos' + 1 + search (row+1) goalPos' orig
  | otherwise = search (row+1) column orig
  where
    dist x = abs $ x - column
    goalPos = if mod row 2 == 0 then min a a' else max b b'
    goalPos' = if mod row 2 == 0 then a else b

{-# OPTIONS -O2 #-}
import Data.List

main = do
  s <- getContents
  let
    (grid:ls) = lines s
    [row, col] = map read $ words grid :: [Int]
    ws' = [(i+1, j+1) |i<-[0..row-1], j<-[0..col-1], (ls !! i) !! j == 'W']
    ws = [(r, (minimum [x|(y,x)<-ws', y==r], maximum [x|(y,x)<-ws', y==r])) | r <- [1..row], elem 'W' (ls !! (r-1))]
  print $ search 1 1 ws

search _ _ [] = 0
search row column [(r, (a, b))]= if mod row 2 == 0 then column - a else b - column
search row column orig@((r, (a, b)):(r', (a', b')):rows)
  | row == r && row + 1 == r' = dist goalPos + 1 + search (row+1) goalPos ((r', (a', b')):rows)
  | row == r || row + 1 == r = dist goalPos' + 1 + search (row+1) goalPos' ((r', (a', b')):rows)
  | otherwise = search (row+1) column orig
  where
    dist x = abs $ x - column
    goalPos = if mod row 2 == 0 then min a a' else max b b'
    goalPos' = if mod row 2 == 0 then a else b

import Data.List
import qualified Data.Map as Map
import Data.Map ((!))
import Control.Monad
import Control.Applicative
import Debug.Trace

traceS a b = trace (show a) b

type Z = Int

data Dir = L | R deriving Show

antiDir L = R
antiDir R = L

solve :: Z -> Z -> [String] -> Z
solve n m ls = solve' n m ls' 0 R
  where ls' = cutter ls

cutter ls = reverse $ cutter' (reverse ls)

cutter' [] = []
cutter' ls =
  case elemIndex 'W' l of
    Nothing -> cutter' lss
    Just _  -> ls
  where (l:lss) = ls

solve' _ _ [] _ _ = 0
solve' n m [l] c L = c - (elemFind c l)
solve' n m [l] c R = abs $ c - (elemFind (m-c-1) (reverse l))
solve' n m (l1:lrem@(l2:ls)) c dir =
  abs (t-c) + solve' n m lrem t (antiDir dir) + 1
  where t = getTarget c m l1 l2 dir

getTarget c m l1 l2 L = min t1 t2
  where t1 = elemFind c l1
        t2 = elemFind c l2
getTarget c m l1 l2 R = m - (1 + getTarget (m-c-1) m (reverse l1) (reverse l2) L)

elemFind c l1 =
  case elemIndex 'W' l1 of
    Nothing -> c
    Just t1 -> min t1 c

main = do
  (n,m) <- (\[a,b] -> (a,b)) . map read . words <$> getLine
  ls <- replicateM n getLine
  print $ solve n m ls

import Data.List
import qualified Data.Map as Map
import Data.Map ((!))
import Control.Monad
import Control.Applicative
import Debug.Trace

traceS a b = trace (show a) b

type Z = Int

data Dir = L | R deriving Show

antiDir L = R
antiDir R = L

solve :: Z -> Z -> [String] -> Z
solve n m ls = solve' n m ls' 0 R
  where ls' = cutter ls

cutter [] = []
cutter ls =
  case elemIndex 'W' l of
    Nothing -> cutter lss
    Just _  -> ls
  where (l:lss) = reverse ls

solve' _ _ [] _ _ = 0
solve' n m [l] c L = c - (elemFind c l)
solve' n m [l] c R = abs $ c - (elemFind (m-c-1) (reverse l))
solve' n m (l1:lrem@(l2:ls)) c dir =
  traceS (abs (t-c),dir) $ abs (t-c) + solve' n m lrem t (antiDir dir) + 1
  where t = getTarget c m l1 l2 dir

getTarget c m l1 l2 L = min t1 t2
  where t1 = elemFind c l1
        t2 = elemFind c l2
getTarget c m l1 l2 R = m - (1 + getTarget (m-c-1) m (reverse l1) (reverse l2) L)

elemFind c l1 =
  case elemIndex 'W' l1 of
    Nothing -> c
    Just t1 -> min t1 c

main = do
  (n,m) <- (\[a,b] -> (a,b)) . map read . words <$> getLine
  ls <- replicateM n getLine
  print $ solve n m ls

import Data.List
import qualified Data.Map as Map
import Data.Map ((!))
import Control.Monad
import Control.Applicative
import Debug.Trace

traceS a b = trace (show a) b

type Z = Int

data Dir = L | R deriving Show

antiDir L = R
antiDir R = L

solve :: Z -> Z -> [String] -> Z
solve n m ls = solve' n m ls 0 R

solve' n m [l] c L = c - (elemFind c l)
solve' n m [l] c R = abs $ c - (elemFind (m-c-1) (reverse l))
solve' n m (l1:lrem@(l2:ls)) c dir =
  traceS (abs (t-c),dir) $ abs (t-c) + solve' n m lrem t (antiDir dir) + 1
  where t = getTarget c m l1 l2 dir

getTarget c m l1 l2 L = min t1 t2
  where t1 = elemFind c l1
        t2 = elemFind c l2
getTarget c m l1 l2 R = m - (1 + getTarget (m-c-1) m (reverse l1) (reverse l2) L)

elemFind c l1 =
  case elemIndex 'W' l1 of
    Nothing -> c
    Just t1 -> min t1 c

main = do
  (n,m) <- (\[a,b] -> (a,b)) . map read . words <$> getLine
  ls <- replicateM n getLine
  print $ solve n m ls


You are given a rectangular grid with $$$n$$$ rows and $$$m$$$ columns. The cell located on the $$$i$$$-th row from the top and the $$$j$$$-th column from the left has a value $$$a_{ij}$$$ written in it.You can perform the following operation any number of times (possibly zero):  Choose any two adjacent cells and multiply the values in them by $$$-1$$$. Two cells are called adjacent if they share a side. Note that you can use a cell more than once in different operations.You are interested in $$$X$$$, the sum of all the numbers in the grid. What is the maximum $$$X$$$ you can achieve with these operations?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$,$$$m$$$ ($$$2 \le n$$$, $$$m \le 10$$$).  The following $$$n$$$ lines contain $$$m$$$ integers each, the $$$j$$$-th element in the $$$i$$$-th line is $$$a_{ij}$$$ ($$$-100\leq a_{ij}\le 100$$$).

For each testcase, print one integer $$$X$$$, the maximum possible sum of all the values in the grid after applying the operation as many times as you want.

NoteIn the first test case, there will always be at least one $$$-1$$$, so the answer is $$$2$$$. In the second test case, we can use the operation six times to elements adjacent horizontally and get all numbers to be non-negative. So the answer is: $$$2\times 1 + 3\times2 + 3\times 3 + 2\times 4 + 1\times 5 = 30$$$.

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process ([n, _]:xss) =
  let (xs, xss') = splitAt n xss
   in solve xs : process xss'

solve :: [[Int]] -> Int
solve xs
  | elem 0 ys || even neg = sum ys'
  | otherwise = sum ys' - 2 * minimum ys'
  where
    ys = concat xs
    ys' = map abs ys
    neg = length . filter (< 0) $ ys

import Data.List
import System.IO

main :: IO ()
main = do
    input <- getContents
    putStr $ solve $ tail $ map read $ words input

solve :: [Int] -> String
solve [] = ""
solve (n:m:rs) = let (cur,rest) = splitAt (n*m) rs
                     lt0 = filter (<0) cur
                     abs_list = map abs cur
                     all_sum = sum abs_list
                     ans = if even $ length lt0
                           then all_sum
                           else all_sum - 2*(minimum abs_list)
                 in (show ans) ++ "\n" ++ solve rest
solve _ = ""

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

solve :: [Int] -> [Int]
solve [] = []
solve (n:m:rs) = ans:(solve rest)
    where (cur,rest) = splitAt (n*m) rs
          lt0_cnt = length $ filter (<0) cur
          abs_list = map abs cur
          abs_sum = sum abs_list
          ans = if even lt0_cnt
                then abs_sum
                else abs_sum - 2*(minimum abs_list)
solve _ = []

import Data.List
import System.IO

main :: IO ()
main = do
    input <- getContents
    putStr $ solve $ tail $ map read $ words input

solve :: [Int] -> String
solve [] = ""
solve (n:m:rs) = let sz = n*m
                     (cur,rest) = splitAt sz rs
                     lt0 = filter (<0) cur
                     abs_list = map abs cur
                     all_sum = sum abs_list
                     ans = if even $ length lt0
                           then all_sum
                           else all_sum - 2*(minimum abs_list)
                 in (show ans) ++ "\n" ++ solve rest
solve _ = ""

import Control.Monad
{-
n rows
m columns
cell i-th row j-th column from the left has value a(i,j)

can do following operation any number of times:
  choose any two adjacent cells and multiply the values in them by -1
  two cells are called adjacent if they share a side
-}

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

rowsToIntList :: Int -> IO [Int]
rowsToIntList 0 = return []
rowsToIntList n = do
  thisRow <- (map read . words) <$> getLine
  nextRow <- rowsToIntList (n - 1)
  return $ mappend thisRow nextRow

counter :: Int -> (Int, Int, Int) -> (Int, Int, Int)
counter a (sumAbs, negativeCount, smallestAbs) = (sumAbs + abs a, negativeCount + negativeIncrement, min smallestAbs (abs a))
  where
    negativeIncrement = if a < 0 then 1 else 0

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    [n, m] <- (map read . words) <$> getLine :: IO [Int]
    rows <- rowsToIntList n
    let (sumAbs, negativeCount, smallestAbs) = foldr counter (0, 0, abs (head rows)) rows
    case even negativeCount of
      True -> putStrLn $ show $ sumAbs
      False -> putStrLn $ show $ sumAbs - 2 * smallestAbs

readCases :: [Int] -> [[Int]]
readCases [] = []
readCases (r:c:ws) = cs : readCases rs
  where (cs, rs) = splitAt (r*c) ws

findMaxSum :: [Int] -> Int
findMaxSum as
  | odd $ numNegetive as = sum as' - (2 * minimum as')
  | otherwise = sum as'
  where as' = map abs as
        numNegetive = length . filter (<0)

solve :: String -> String
solve = unlines . map show . map findMaxSum . readCases . map read . tail . words

main = interact solve

import Data.List
import System.IO

main :: IO ()
main = do
    input <- getContents
    putStr $ solve $ tail $ map read $ words input

solve :: [Int] -> String
solve [] = ""
solve (n:m:rs) = let sz = n*m
                     (cur,rest) = splitAt sz rs
                     eq0 = filter (==0) cur
                     lt0 = filter (<0) cur
                     tmp = (sum cur)-2*(sum lt0)
                     ans = if (length eq0 > 0) || (even $ length lt0)
                           then tmp
                           else tmp + 2*(maximum lt0)
                 in (show ans) ++ "\n" ++ solve rest
solve _ = ""


The capital of Berland has n multifloor buildings. The architect who built up the capital was very creative, so all the houses were built in one row.Let's enumerate all the houses from left to right, starting with one. A house is considered to be luxurious if the number of floors in it is strictly greater than in all the houses with larger numbers. In other words, a house is luxurious if the number of floors in it is strictly greater than in all the houses, which are located to the right from it. In this task it is assumed that the heights of floors in the houses are the same.The new architect is interested in n questions, i-th of them is about the following: "how many floors should be added to the i-th house to make it luxurious?" (for all i from 1 to n, inclusive). You need to help him cope with this task.Note that all these questions are independent from each other — the answer to the question for house i does not affect other answers (i.e., the floors to the houses are not actually added).

The first line of the input contains a single number n (1 ≤ n ≤ 105) — the number of houses in the capital of Berland. The second line contains n space-separated positive integers hi (1 ≤ hi ≤ 109), where hi equals the number of floors in the i-th house.

Print n integers a1, a2, ..., an, where number ai is the number of floors that need to be added to the house number i to make it luxurious. If the house is already luxurious and nothing needs to be added to it, then ai should be equal to zero. All houses are numbered from left to right, starting from one.

readInt :: IO Int
readInt = do
    getLine >>= return . read

readCase :: IO [Int]
readCase = do
    readInt   -- Read and do nothing
    getLine >>= return . (map read . words)

constructArray :: [Int] -> ([Int], Int)
constructArray [] = ([], 0)
constructArray (x:xs) =  (y, z)
    where ans = constructArray xs
          z = max x (snd ans)
          y = (max 0 ((snd ans)-x+1)) : (fst ans)

main :: IO()
main = do
    readCase >>= putStrLn . unwords . (map show) .  fst . constructArray

main = do
        getLine
        interact $ unwords.map show.reverse.solve.reverse.map read.words
solve (x:xs) = 0:res x xs
  where res _ [] = []
        res m (x:xs)|m>=x      = m-x+1:res m xs
                    |otherwise = 0:res x xs

import Data.List (intercalate)
main=interact $ intercalate " ". (map show).solve . (map read) . tail. words
solve :: [Int]->[Int]
solve s = reverse ([0] ++ (zipWith (\a b->max (b-a+1) 0) (tail $ reverse s) (scanl1 max $ reverse s)))

main=interact $ solve . (map read) . tail. words
solve s = unwords $ map show $ reverse $ [0] ++ (zipWith (\a b->max (b-a+1) 0) (tail $ reverse s) (scanl1 max $ reverse s))

main = do
    n <- getLine
    numbersString <- getLine
    let numbers = map read (words numbersString) :: [Int]
    let maxes = scanr max 0 numbers
    let answers = [if m >= num then (m+1-num) else 0 | (num, m) <- zip numbers (tail maxes)]
    putStrLn (unwords $ map show answers)

main :: IO()
main = putStrLn . unwords . map show . solve . map read . tail . words =<< getContents

solve :: [Int] -> [Int]
solve a = let m = getMax a
          in solve' a (tail m)

solve' :: [Int] -> [Int] -> [Int]
solve' []    []     = []
solve' (a:s) (m:ms) | a > m     = 0 : solve' s ms
                    | otherwise = (m - a + 1) : solve' s ms

getMax :: [Int] -> [Int]
getMax []    = [0]
getMax (a:s) = let next = getMax s
               in (max a (head next)):next

main = do
  n <- readLn :: IO Int
  a <- fmap ((map read) . words) getLine :: IO [Int]
  let list = reverse $ 0:solve (last a) (reverse . init $a)
  mapM_ (\x -> putStrLn (show x ++ " ")) list

solve m [] = []
solve m (x:xs)
 |x>m = 0:solve x xs
 |otherwise = m-x+1:solve m xs

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

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

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

main = do
  getLine
  hs <- getInts

  putStrLn $ unwords $ map show $ zipWith (\m h -> if h > m then 0 else m-h+1) (tail $ scanr max 0 hs) hs

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

	let
		ms = tail (scanr1 max as) ++ [0]
		res = map (\(v, m) -> if v > m then 0 else m + 1 - v) $ zip as ms

	putStrLn $ unwords . map show $ res

import Data.List (intercalate)
mac (h:t) | null t = [(h-1)]
          | otherwise = (max th mx):next
             where next = mac t
                   th = head t
                   mx = max th (head next)
main = do
  w0 <- getLine
  w1 <- getLine
  let h = [read n::Int|n <-(words w1)]
  let c = map (+1) $ mac h
  let res = map (\x -> max 0 ((fst x) - (snd x))) $ zip c h
  putStrLn $ intercalate " " $ map show res

main = interact $ unwords . map show . solve . map read . tail . words
solve = map (max 0 . succ) . (zipWith (-) =<< tail . scanr max (-1))

import Control.Monad

maxRight :: [Int] -> [Int]
maxRight []     = [0]
maxRight (x:xs) = max x (head ys) : ys
  where ys = maxRight xs

solve :: [Int] -> [Int]
solve xs = zipWith f xs (tail $ maxRight xs)
  where f a b = if a <= b then b + 1 - a else 0

ansJoin :: Show a => [a] -> String
ansJoin = tail . foldr (++) "" . map ((++) " ". show)

main :: IO ()
main =
  getLine >>= \n ->
  getLine >>= putStrLn . ansJoin . solve . map read . words

-- maxRight: O(n)
maxRight :: [Int] -> [Int]
maxRight []     = [0]
maxRight (x:xs) = max x (head ys) : ys
  where ys = maxRight xs

-- solve: O(n)
solve :: [Int] -> [Int]
solve xs = zipWith f xs (tail $ maxRight xs)
  where f a b = if a <= b then b + 1 - a else 0

main :: IO ()
main =
  getLine >>= \n ->
  getLine >>= putStrLn . unwords . map show . solve . map read . words

import qualified Data.Map as Map

luxury :: (Integral a) => [a] -> [a]
luxury values =
    let counts = foldr (\v c -> Map.insertWith (+) v 1 c) Map.empty values
    in reverse $ fst $ foldl step ([], counts) values
        where step (res, counts) v =
                let nm = Map.update (\c -> if c > 1 then (Just (c-1)) else Nothing) v counts
                in if Map.null nm then (0:res, nm)
                else ((((max ((fst $ (Map.findMax nm))+1) v) - v):res), nm)

main = do
    inp <- getContents
    let values = map read $ words $ head $ tail $ lines inp :: [Int]
    putStrLn $ unwords $ map show $ luxury values

import Control.Applicative
import Data.List
import Data.Char

main= do
	getLine
	s<- map read. words <$> getLine ::IO [Int]
	let t = tail $ scanr max 0 s
	putStrLn $ intercalate " " $ map show $ zipWith (\a b ->    (max 0 (b+1-a))) s t

import Control.Applicative

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine

inputInts = inputRow :: IO [Int]

go :: [Int] -> ([Int], Int)
go [] = ([], 0)
go (a:as) = ([max (b - a + 1) 0] ++ r1, max a b)
    where (r1, b) = go as

trans :: [Int] -> String
trans [a] = show a
trans (a:as) = show a ++ " " ++ trans as

main :: IO()
main = do
    [ln] <- inputInts
    lst <- inputInts
    putStrLn (trans(fst(go lst)))

main = do
        getLine
        interact $ unwords.map show.reverse.solve.reverse.map read.words
solve (x:xs) = 0:res x xs
  where res _ [] = []
        res m (x:xs)|m>=x      = m-x+1:res(m+1) xs
                    |otherwise = 0:res m xs

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words ) getLine :: IO [Int]
    mapM_ (\x -> putStr ((show x)++" ")) $ (zipWith (\x y -> y-x+1) a (init (scanr max (last a) (init a)))) ++ [0]

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words ) getLine :: IO [Int]
    let ml = scanr max (last a) (init a)
        ans = solve a ml
    printList ans

solve [] [] = []
solve (x:xs) (y:ys)
 |x==y = 0 : solve xs ys
 |otherwise = y-x+1 : solve xs ys

printList = mapM_ (\x -> putStr ((show x)++" "))

main = do
  n <- readLn :: IO Int
  a <- fmap ((map read) . words) getLine :: IO [Int]
  let list = reverse $ 0:solve (last a) (reverse . init $a)
  mapM_ (\x -> putStrLn (show x ++ " ")) list

solve m [] = []
solve m (x:xs)
 |x>=m = 0:solve x xs
 |otherwise = m-x+1:solve m xs

main = do
  n <- readLn :: IO Int
  a <- fmap ((map read) . words) getLine :: IO [Int]
  let list = 0:solve (last a) (init a)
  mapM_ (\x -> putStrLn (show x ++ " ")) (init list)

solve m [] = []
solve m (x:xs)
 |x>=m = 0:solve x xs
 |otherwise = m-x+1:solve m xs

main = do
  n <- readLn :: IO Int
  a <- fmap ((map read) . words) getLine :: IO [Int]
  let list = reverse $ 0:solve (last a) (reverse . init $a)
  mapM_ (\x -> putStr ((show x) ++ " ")) list

solve m [] = []
solve m (x:xs)
 |x>=m = 0:solve x xs
 |otherwise = m-x+1:solve m xs

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words ) getLine :: IO [Int]
    mapM_ (\x -> putStr ((show x)++" ")) $ zipWith (\x y -> if x==y then 0 else y-x+1) a (scanr max (last a) (init a))

import Data.List (intercalate)
mac (h:t) | null t = [(h-1)]
          | otherwise = (max th mx):next
             where next = mac t
                   th = head t
                   mx = max th (head next)
main = do
  w0 <- getLine
  w1 <- getLine
  let h = [read n::Int|n <-(words w1)]
  let c = map (+1) $ mac h
  let res = map (\x -> (fst x) - (snd x)) $ zip c h
  putStrLn $ intercalate " " $ map show res

import Control.Applicative
import Data.List
import Data.Char

main= do
	getLine
	s<- map read. words <$> getLine ::IO [Int]
	let t = tail $ scanr max 0 s
	putStrLn $ intercalate " " $ map show $ zipWith (\a b -> if b==a then 0 else  (max 0 (b+1-a))) s t

import Control.Applicative
import Data.List
import Data.Char

main= do
	getLine
	s<- map read. words <$> getLine ::IO [Int]
	let t = scanr max 0 s
	putStrLn $ intercalate " " $ map show $ zipWith (\a b -> if b==a then 0 else  b+1-a) s t


A map of some object is a rectangular field consisting of n rows and n columns. Each cell is initially occupied by the sea but you can cover some some cells of the map with sand so that exactly k islands appear on the map. We will call a set of sand cells to be island if it is possible to get from each of them to each of them by moving only through sand cells and by moving from a cell only to a side-adjacent cell. The cells are called to be side-adjacent if they share a vertical or horizontal side. It is easy to see that islands do not share cells (otherwise they together form a bigger island).Find a way to cover some cells with sand so that exactly k islands appear on the n × n map, or determine that no such way exists.

The single line contains two positive integers n, k (1 ≤ n ≤ 100, 0 ≤ k ≤ n2) — the size of the map and the number of islands you should form.

If the answer doesn't exist, print "NO" (without the quotes) in a single line. Otherwise, print "YES" in the first line. In the next n lines print the description of the map. Each of the lines of the description must consist only of characters 'S' and 'L', where 'S' is a cell that is occupied by the sea and 'L' is the cell covered with sand. The length of each line of the description must equal n. If there are multiple answers, you may print any of them. You should not maximize the sizes of islands.

import Control.Applicative

makeline :: Int -> Int -> Int -> Int -> String
makeline f n k i
  | i == n = []
  | otherwise = fc : makeline f n k2 (i+1)
    where cond = (k > 0) && ( (f + i) `mod` 2 == 0)
          fc = if cond then 'L' else 'S'
          k2 = if cond then k-1 else k

doit :: Int -> Int -> Int -> [String]
doit cur n k
  | cur == n = []
  | otherwise = makeline cur n k 0 : doit (cur+1) n (k2 `max` 0)
      where k2 = k - (n + 1 - cur `mod` 2) `div` 2

main = do
    inp <-  map read . words <$> getLine
    let n = head inp
        k = head . tail $ inp
        m = (n*n+1) `div` 2
    putStr $ unlines $ if k > m then ["NO"] else "YES":doit 0 n k


Polycarp has built his own web service. Being a modern web service it includes login feature. And that always implies password security problems.Polycarp decided to store the hash of the password, generated by the following algorithm:  take the password $$$p$$$, consisting of lowercase Latin letters, and shuffle the letters randomly in it to obtain $$$p'$$$ ($$$p'$$$ can still be equal to $$$p$$$);  generate two random strings, consisting of lowercase Latin letters, $$$s_1$$$ and $$$s_2$$$ (any of these strings can be empty);  the resulting hash $$$h = s_1 + p' + s_2$$$, where addition is string concatenation. For example, let the password $$$p =$$$ "abacaba". Then $$$p'$$$ can be equal to "aabcaab". Random strings $$$s1 =$$$ "zyx" and $$$s2 =$$$ "kjh". Then $$$h =$$$ "zyxaabcaabkjh".Note that no letters could be deleted or added to $$$p$$$ to obtain $$$p'$$$, only the order could be changed.Now Polycarp asks you to help him to implement the password check module. Given the password $$$p$$$ and the hash $$$h$$$, check that $$$h$$$ can be the hash for the password $$$p$$$.Your program should answer $$$t$$$ independent test cases.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains a non-empty string $$$p$$$, consisting of lowercase Latin letters. The length of $$$p$$$ does not exceed $$$100$$$. The second line of each test case contains a non-empty string $$$h$$$, consisting of lowercase Latin letters. The length of $$$h$$$ does not exceed $$$100$$$.

For each test case print the answer to it — "YES" if the given hash $$$h$$$ could be obtained from the given password $$$p$$$ or "NO" otherwise.

5
abacaba
zyxaabcaabkjh
onetwothree
threetwoone
one
zzonneyy
one
none
twenty
ten

NoteThe first test case is explained in the statement.In the second test case both $$$s_1$$$ and $$$s_2$$$ are empty and $$$p'=$$$ "threetwoone" is $$$p$$$ shuffled.In the third test case the hash could not be obtained from the password.In the fourth test case $$$s_1=$$$ "n", $$$s_2$$$ is empty and $$$p'=$$$ "one" is $$$p$$$ shuffled (even thought it stayed the same). In the fifth test case the hash could not be obtained from the password.

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Safe     #-}
module Main where

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

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- getPairs <$> replicateM (2*n) B.getLine
  B.putStr (B.unlines (map verify xs))

bInt = fst . fromJust . B.readInt

type Hash = B.ByteString
type Pass = B.ByteString

getPairs :: [B.ByteString] -> [(Pass, Hash)]
getPairs (x:y:xs) = (x, y):getPairs xs
getPairs _ = []

verify :: (Pass, Hash) -> B.ByteString
verify (p, h) | p' `elem` h' = "YES"
              | otherwise = "NO"
              where p' = B.sort (B.take n p)
                    h' = map (B.sort . B.take n) $ B.tails h
                    n = B.length p - 1

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Safe     #-}
module Main where

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

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- getPairs <$> replicateM (2*n) B.getLine
  print xs
  B.putStr (B.unlines (map verify xs))

bInt = fst . fromJust . B.readInt

type Hash = B.ByteString
type Pass = B.ByteString

getPairs :: [B.ByteString] -> [(Pass, Hash)]
getPairs (x:y:xs) = (x, y):getPairs xs
getPairs _ = []

verify :: (Pass, Hash) -> B.ByteString
verify (p, h) | p' `elem` h' = "YES"
              | otherwise = "NO"
              where p' = B.sort p
                    h' = map (B.sort . B.take n) $ B.tails h
                    n = B.length p

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Safe     #-}
module Main where

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

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- getPairs <$> replicateM (2*n) B.getLine
  B.putStr (B.unlines (map verify xs))

bInt = fst . fromJust . B.readInt

type Hash = B.ByteString
type Pass = B.ByteString

getPairs :: [B.ByteString] -> [(Pass, Hash)]
getPairs (x:y:xs) = (x, y):getPairs xs
getPairs _ = []

verify :: (Pass, Hash) -> B.ByteString
verify (p, h) | p' `elem` h' = "YES"
              | otherwise = "NO"
              where p' = B.sort p
                    h' = map (B.sort . B.take n) $ B.tails h
                    n = B.length p

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Safe     #-}
module Main where

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

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- getPairs <$> replicateM (2*n) B.getLine
  print xs
  B.putStr (B.unlines (map verify xs))

bInt = fst . fromJust . B.readInt

type Hash = B.ByteString
type Pass = B.ByteString

getPairs :: [B.ByteString] -> [(Pass, Hash)]
getPairs (x:y:xs) = (x, y):getPairs xs
getPairs _ = []

verify :: (Pass, Hash) -> B.ByteString
verify (p, h) | p' `elem` h' = "YES"
              | otherwise = "NO"
              where p' = B.sort (B.take n p)
                    h' = map (B.sort . B.take n) $ B.tails h
                    n = B.length p - 1


Valera had two bags of potatoes, the first of these bags contains x (x ≥ 1) potatoes, and the second — y (y ≥ 1) potatoes. Valera — very scattered boy, so the first bag of potatoes (it contains x potatoes) Valera lost. Valera remembers that the total amount of potatoes (x + y) in the two bags, firstly, was not gerater than n, and, secondly, was divisible by k.Help Valera to determine how many potatoes could be in the first bag. Print all such possible numbers in ascending order.

The first line of input contains three integers y, k, n (1 ≤ y, k, n ≤ 109;   ≤ 105).

Print the list of whitespace-separated integers — all possible values of x in ascending order. You should print each possible value of x exactly once. If there are no such values of x print a single integer -1.

getMult :: Int -> Int -> Int -> [Int]
getMult y k n
	| div n k == div y k	= []
	| otherwise				= (n - (mod n k) - y) : (getMult y k (n - k))

printList :: [Int] -> IO()
printList [] = do
	putStrLn ""
printList (a:b) = do
	putStr ((show a) ++ " ")
	printList b

main :: IO()
main = do
	str <- getLine
	let y = read ((words str) !! 0)
	let k = read ((words str) !! 1)
	let n = read ((words str) !! 2)
	if (div n k <= div y k)
		then putStrLn "-1"
		else printList (reverse (getMult y k n))

main = interact $ unwords . map show . solve . map read . words
solve [y,k,n]
  | k - mod y k > n - y = [-1]
  | otherwise = [k - mod y k, 2 * k - mod y k .. n - y]

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.List
import Control.Monad
import Control.Monad.ST.Safe
-- import Debug.Trace

getInts = fmap (map read . words) getLine :: IO [Int]

main = do
  [y, k, n] <- getInts

  let a = filter (>= 1) $ map (\s -> s-y) $ takeWhile (<= n) $ map (*k) [1..]

  if null a
     then print $ -1
     else putStrLn $ unwords $ map show a

main :: IO ()
main = do [y,k,n] <- (getLine >>= (return . map read . words))
          let l = [ z - y | z <- [k,2*k..n], z > y]
          let ans = if l == [] then [-1] else l
          putStrLn . unwords . map show $ ans

main = do
    x <- getLine
    putStrLn $ unwords $ map show $ f1 $ (\[a,b,c] -> map (\t -> t-a) $ f a b c) $ map (\a -> read a::Int) $ words x

f1 :: [Int] -> [Int]
f1 [] = [-1]
f1 x = x

f :: Int -> Int -> Int -> [Int]
f y k n
    | mod (y+1) k == 0 = [y+1,y+1+k..n]
    | otherwise = f (k*((div y k)+1)-1) k n

main :: IO ()
main = interact $ (\x -> if null x then "-1" else unwords $ map show x) . testcase . map read . words

testcase :: [Integer] -> [Integer]
testcase [y,k,n] = [ x | pos <- takeWhile (<=n) (iterate (+k) k), let x = pos - y, x >= 1]

import Control.Monad (liftM)

solve :: [Int] -> [Int]
solve [y, k, n]  =  map (\z -> z - y) [x, x + k .. n]
  where
    x  =  (y `div` k + 1) * k

prints :: Show a => [a] -> IO ()
prints []      =  print (-1)
prints [x]     =  print x
prints (x:xs)  =  putStr (show x ++ " ") >> prints xs

main :: IO ()
main  =  liftM (map read . words) getLine >>= prints . solve

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [ y, k, n ] = head $ filter (not . null) $ [(y `div` k + 1) * k - y, (y `div` k + 2) * k - y .. n - y] : [[-1]]
solve _ = undefined

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [ y, k, n ] = head $ filter (not . null) $ [k - y `mod` k, 2 * k - y `mod` k .. n - y] : [[-1]]
solve _ = undefined

main=interact$unwords.map show.f.map read.words
f[y,k,n]= case dropWhile(<=0)[(-y)`mod`k,(-y)`mod`k+k..n-y] of
            [] -> [-1]
            xs -> xs

import Control.Applicative
import Data.Ratio
import Data.List
main = do
    [y,k,n] <- map read . words <$> getLine
    let l1 = [ m*k + c1 | m <- [0..(n-y-c1)`div`k]]
        c1 = k - y`mod`k
    case (l1 == []) of
        False -> putStrLn.unwords.map show $ l1
        True -> print (-1)

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

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

parse = map read . words

solve :: [Int] -> [Int]
solve [y, k, n] =
  map (\x -> x - y) $ dropWhile (<= y) $ takeWhile (<= n) [x | x <- [k, 2*k ..]]

present :: [Int] -> String
present [] = "-1"
present foo = unwords $ map show foo

main = interact $ present . solve . parse

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [ y, k, n ] = head $ filter (not . null) $ [((y + k - 1) `div` k) * k - y, ((y + 2 * k - 1) `div` k) * k - y .. n - y] : [[-1]]
solve _ = undefined

import Control.Applicative
import Data.Ratio
import Data.List
main = do
    [y,k,n] <- map read . words <$> getLine
    let l2 = sort [x | x <- [0..n-y], (x+y)`mod`k==0]
    case (l2 == []) of
        False -> putStrLn.unwords.map show $ l2
        True -> print (-1)

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

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

parse = map read . words

solve :: [Int] -> [Int]
solve [y, k, n] =
  map (\x -> x - y) $ dropWhile (<y) $ takeWhile (<= n) [x | x <- [k, 2*k ..]]

present :: [Int] -> String
present [] = "-1"
present foo = unwords $ map show foo

main = interact $ present . solve . parse

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

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

parse = map read . words

solve :: [Int] -> [Int]
solve [y, k, n] =
  map (\x -> x - y) $ dropWhile (<y) $ takeWhile (<n) [x | x <- [k, 2*k ..]]

present :: [Int] -> String
present [] = "-1"
present foo = unwords $ map show foo

main = interact $ present . solve . parse


You have an image file of size $$$2 \times 2$$$, consisting of $$$4$$$ pixels. Each pixel can have one of $$$26$$$ different colors, denoted by lowercase Latin letters.You want to recolor some of the pixels of the image so that all $$$4$$$ pixels have the same color. In one move, you can choose no more than two pixels of the same color and paint them into some other color (if you choose two pixels, both should be painted into the same color).What is the minimum number of moves you have to make in order to fulfill your goal?

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case consists of two lines. Each of these lines contains two lowercase letters of Latin alphabet without any separators, denoting a row of pixels in the image.

For each test case, print one integer — the minimum number of moves you have to make so that all $$$4$$$ pixels of the image have the same color.

5

rb

br

cc

wb

aa

aa

ab

cd

yy

xx

NoteLet's analyze the test cases of the example.In the first test case, you can paint the bottom left pixel and the top right pixel (which share the same color) into the color r, so all pixels have this color.In the second test case, two moves are enough:  paint both top pixels, which have the same color c, into the color b;  paint the bottom left pixel into the color b. In the third test case, all pixels already have the same color.In the fourth test case, you may leave any of the pixels unchanged, and paint all three other pixels into the color of that pixel in three moves.In the fifth test case, you can paint both top pixels into the color x.

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

solve as =
    let as' = group $ sort as
    in length as' - 1

read = do
    s1 <- C.getLine
    s2 <- C.getLine

    print $ solve [s1 `B.index` 0, s1 `B.index` 1, s2 `B.index` 0, s2 `B.index` 1]

main :: IO()
main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) Main.read

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- repaint.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        sort . concat <$> replicateM 2 getLine
    mapM_ (putStrLn.show.solve) tcs

solve = length . init . sortOn length . group

import Data.Set

computeProg n = (1 + n) * n `div` 2

decide n = decideBody n
decideBody 0 = return ()
decideBody n = do
    s1 <- getLine
    s2 <- getLine
    case (size $ fromList (s1 ++ s2)) of
        1 -> putStrLn (show 0)
        2 -> putStrLn (show 1)
        3 -> putStrLn (show 2)
        4 -> putStrLn (show 3)
    decideBody $ n - 1

main :: IO ()
main = do
    t <- getLine >>= (return . (read :: String -> Int))
    decide t


Today, Marin is at a cosplay exhibition and is preparing for a group photoshoot!For the group picture, the cosplayers form a horizontal line. A group picture is considered beautiful if for every contiguous segment of at least $$$2$$$ cosplayers, the number of males does not exceed the number of females (obviously).Currently, the line has $$$n$$$ cosplayers which can be described by a binary string $$$s$$$. The $$$i$$$-th cosplayer is male if $$$s_i = 0$$$ and female if $$$s_i = 1$$$. To ensure that the line is beautiful, you can invite some additional cosplayers (possibly zero) to join the line at any position. You can't remove any cosplayer from the line.Marin wants to know the minimum number of cosplayers you need to invite so that the group picture of all the cosplayers is beautiful. She can't do this on her own, so she's asking you for help. Can you help her?

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases.  The first line of each test case contains a positive integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the number of cosplayers in the initial line. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$ — describing the cosplayers already in line. Each character of the string is either 0 describing a male, or 1 describing a female. Note that there is no limit on the sum of $$$n$$$.

For each test case, print the minimum number of cosplayers you need to invite so that the group picture of all the cosplayers is beautiful.

NoteIn the first test case, for each pair of adjacent cosplayers, you can invite two female cosplayers to stand in between them. Then, $$$000 \rightarrow 0110110$$$.In the third test case, you can invite one female cosplayer to stand next to the second cosplayer. Then, $$$010 \rightarrow 0110$$$.

-- https://codeforces.com/contest/1679/problem/D
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE LambdaCase #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: B8.ByteString -> Int
solve str = flip S.evalState ((0, 2)::(Int, Int)) $ do
    forM_ (B8.unpack str) $ \case
        '0' -> S.modify $ \(answer, cnt1) -> (answer + max (2 - cnt1) 0, 0)
        '1' -> S.modify $ \(answer, cnt1) -> (answer, cnt1 + 1)
    (answer, _) <- S.get
    return answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        str <- B8.getLine <&> head . B8.words
        let answer = solve str
        printf "%d\n" answer

import Control.Monad (replicateM_)

solve :: Int -> [Char] -> Int
solve _ [] = 0
solve c (x : xs) =
    if x == '1'
        then solve (c + 1) xs
        else max (2 - c) 0 + solve 0 xs

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t $ do
        getLine
        l <- getLine
        print $ solve 2 l


This is the easy version of the problem. The difference is the constraints on $$$n$$$, $$$m$$$ and $$$t$$$. You can make hacks only if all versions of the problem are solved.Alice and Bob are given the numbers $$$n$$$, $$$m$$$ and $$$k$$$, and play a game as follows:The game has a score that Alice tries to maximize, and Bob tries to minimize. The score is initially $$$0$$$. The game consists of $$$n$$$ turns. Each turn, Alice picks a real number from $$$0$$$ to $$$k$$$ (inclusive) which Bob either adds to or subtracts from the score of the game. But throughout the game, Bob has to choose to add at least $$$m$$$ out of the $$$n$$$ turns.Bob gets to know which number Alice picked before deciding whether to add or subtract the number from the score, and Alice gets to know whether Bob added or subtracted the number for the previous turn before picking the number for the current turn (except on the first turn since there was no previous turn).If Alice and Bob play optimally, what will the final score of the game be?

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The description of test cases follows. Each test case consists of a single line containing the three integers, $$$n$$$, $$$m$$$, and $$$k$$$ ($$$1 \le m \le n \le 2000, 0 \le k < 10^9 + 7$$$) — the number of turns, how many of those turns Bob has to add, and the biggest number Alice can choose, respectively. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case output a single integer number — the score of the optimal game modulo $$$10^9 + 7$$$. Formally, let $$$M = 10^9 + 7$$$. It can be shown that the answer can be expressed as an irreducible fraction $$$\frac{p}{q}$$$, where $$$p$$$ and $$$q$$$ are integers and $$$q \not \equiv 0 \pmod{M}$$$. Output the integer equal to $$$p \cdot q^{-1} \bmod M$$$. In other words, output such an integer $$$x$$$ that $$$0 \le x < M$$$ and $$$x \cdot q \equiv p \pmod{M}$$$.

NoteIn the first test case, the entire game has $$$3$$$ turns, and since $$$m = 3$$$, Bob has to add in each of them. Therefore Alice should pick the biggest number she can, which is $$$k = 2$$$, every turn.In the third test case, Alice has a strategy to guarantee a score of $$$\frac{75}{8} \equiv 375000012 \pmod{10^9 + 7}$$$.In the fourth test case, Alice has a strategy to guarantee a score of $$$\frac{45}{2} \equiv 500000026 \pmod{10^9 + 7}$$$.

{-# LANGUAGE NumericUnderscores #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

p :: Int
p = 1000_000_007

cv :: Int -> Int
cv x = rem x p

(+!) :: Int -> Int -> Int
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
x *! y = cv $ x * y

half :: Int
half = div (p + 1) 2

step :: UArray Int Int -> UArray Int Int
step arr = let
  (0, n) = bounds arr
  inners li = zipWith (\x y -> (x +! y) *! half) li (tail li)
  in  listArray (0, n+1) $ 0 : inners (elems arr) ++ [n+1]

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    k <- getInt
    pure $ putInts [(*! k) $ iterate step (listArray (0, 0) [0]) !! n ! m]

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

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

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

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

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

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


There is a graph of $$$n$$$ rows and $$$10^6 + 2$$$ columns, where rows are numbered from $$$1$$$ to $$$n$$$ and columns from $$$0$$$ to $$$10^6 + 1$$$:  Let's denote the node in the row $$$i$$$ and column $$$j$$$ by $$$(i, j)$$$.Initially for each $$$i$$$ the $$$i$$$-th row has exactly one obstacle — at node $$$(i, a_i)$$$. You want to move some obstacles so that you can reach node $$$(n, 10^6+1)$$$ from node $$$(1, 0)$$$ by moving through edges of this graph (you can't pass through obstacles). Moving one obstacle to an adjacent by edge free node costs $$$u$$$ or $$$v$$$ coins, as below:  If there is an obstacle in the node $$$(i, j)$$$, you can use $$$u$$$ coins to move it to $$$(i-1, j)$$$ or $$$(i+1, j)$$$, if such node exists and if there is no obstacle in that node currently.  If there is an obstacle in the node $$$(i, j)$$$, you can use $$$v$$$ coins to move it to $$$(i, j-1)$$$ or $$$(i, j+1)$$$, if such node exists and if there is no obstacle in that node currently.  Note that you can't move obstacles outside the grid. For example, you can't move an obstacle from $$$(1,1)$$$ to $$$(0,1)$$$. Refer to the picture above for a better understanding. Now you need to calculate the minimal number of coins you need to spend to be able to reach node $$$(n, 10^6+1)$$$ from node $$$(1, 0)$$$ by moving through edges of this graph without passing through obstacles.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains three integers $$$n$$$, $$$u$$$ and $$$v$$$ ($$$2 \le n \le 100$$$, $$$1 \le u, v \le 10^9$$$) — the number of rows in the graph and the numbers of coins needed to move vertically and horizontally respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^6$$$) — where $$$a_i$$$ represents that the obstacle in the $$$i$$$-th row is in node $$$(i, a_i)$$$. It's guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^4$$$.

For each test case, output a single integer — the minimal number of coins you need to spend to be able to reach node $$$(n, 10^6+1)$$$ from node $$$(1, 0)$$$ by moving through edges of this graph without passing through obstacles. It can be shown that under the constraints of the problem there is always a way to make such a trip possible.

NoteIn the first sample, two obstacles are at $$$(1, 2)$$$ and $$$(2,2)$$$. You can move the obstacle on $$$(2, 2)$$$ to $$$(2, 3)$$$, then to $$$(1, 3)$$$. The total cost is $$$u+v = 7$$$ coins.  In the second sample, two obstacles are at $$$(1, 3)$$$ and $$$(2,2)$$$. You can move the obstacle on $$$(1, 3)$$$ to $$$(2, 3)$$$. The cost is $$$u = 3$$$ coins.

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, u, v] <- readInts
    a : as <- readInts
    let
      canEscapeAlready = or [abs (p - q) > 1 | (p, q) <- zip as $ a : as]
      allSame = all (== a) as
    putInts $ pure $ if  canEscapeAlready
      then  0
      else  min u v + if  allSame
      then  v
      else  0

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

import Control.Monad
import Data.List

main = do
    t <- getLine
    replicateM_ (read t) testcase

testcase :: IO ()
testcase = do
    [n,u,v] <- fmap (map read . words) getLine
    a <- fmap (map read . words) getLine
    putStrLn $ solve n u v a

solve :: Int -> Int -> Int -> [Int] -> String
solve n u v a
    | distance == 0 = show $ min (u+v) (2*v)
    | distance == 1 = show $ min u v
    | otherwise = "0"
    where
        distance = snd $ foldl' (\(last,dist) curr -> (curr,max dist . abs $ last-curr)) (head a,0) a :: Int

{-# LANGUAGE TypeApplications #-}
module Main where

import           Control.Monad                  ( replicateM_ )
import           Data.Array.Unboxed             ( (!)
                                                , UArray
                                                , listArray
                                                )

main :: IO ()
main = do
  t <- readLn
  replicateM_ t eachCase
 where
  eachCase = do
    [n, u, v] <- fmap read . words <$> getLine
    obs       <- fmap (read @Int) . words <$> getLine
    let obsArr = listArray @UArray (1, length obs) obs
    if all (== head obs) (tail obs)
      then print (v + min u v)
      else if any (\i -> abs (obsArr ! i - obsArr ! (i - 1)) > 1) [2 .. length obs] then print 0 else print (min u v)

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, u, v] <- readInts
    a : as <- readInts
    putInts $ pure $ min u v + if  all (== a) as
      then  v
      else  0

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


You are given two integers $$$a$$$ and $$$b$$$. Print $$$a+b$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case is given as a line of two integers $$$a$$$ and $$$b$$$ ($$$-1000 \le a, b \le 1000$$$).

Print $$$t$$$ integers — the required numbers $$$a+b$$$.

import Control.Arrow

main = interact $
	lines >>> drop 1
	>>> map (words >>> map read >>> sum >>> show)
	>>> unlines

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

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

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM)

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInts :: Int -> IO [Int]
getInts n = fmap read <$> getLines n

getInt :: IO Int
getInt = fmap read getLine

workProblem :: [String] -> IO ()
workProblem [] = pure ()
workProblem (x:xs) = do
                    let [num1, num2] = words x
                    let a = read num1 :: Int
                    let b = read num2 :: Int
                    putStrLn $ show (a + b)
                    workProblem xs

main :: IO ()
main = do
         n <- getInt
         lines <- getLines n
         workProblem lines


This is an interactive problem.The jury has a permutation $$$p$$$ of length $$$n$$$ and wants you to guess it. For this, the jury created another permutation $$$q$$$ of length $$$n$$$. Initially, $$$q$$$ is an identity permutation ($$$q_i = i$$$ for all $$$i$$$).You can ask queries to get $$$q_i$$$ for any $$$i$$$ you want. After each query, the jury will change $$$q$$$ in the following way:   At first, the jury will create a new permutation $$$q'$$$ of length $$$n$$$ such that $$$q'_i = q_{p_i}$$$ for all $$$i$$$.  Then the jury will replace permutation $$$q$$$ with pemutation $$$q'$$$. You can make no more than $$$2n$$$ queries in order to quess $$$p$$$.

The first line of input contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases.

NoteIn the first test case the hidden permutation $$$p = [4, 2, 1, 3]$$$.Before the first query $$$q = [1, 2, 3, 4]$$$ so answer for the query will be $$$q_3 = 3$$$.Before the second query $$$q = [4, 2, 1, 3]$$$ so answer for the query will be $$$q_2 = 2$$$.Before the third query $$$q = [3, 2, 4, 1]$$$ so answer for the query will be $$$q_4 = 1$$$.In the second test case the hidden permutation $$$p = [1, 3, 4, 2]$$$.Empty strings are given only for better readability. There will be no empty lines in the testing system.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans.Class (lift)
import Data.Char (isSpace)
import Data.Maybe

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

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

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

readIntIO :: IO Int
readIntIO = do
  t <- getLine
  if all isSpace t then readIntIO else pure . readInt . P.pack $ t

type DoState = StateT (S.Set Int) IO

go :: IO ()
go = do
  n <- readIntIO
  cs <- flip evalStateT S.empty $ fmap (foldr (<>) []) $ mapM findCycles [1..n]
  let
    p :: UArray Int Int
    p = array (1, n) cs
  P.putStr $ toLazyByteString $ char7 '!' <> char7 ' ' <> (putInts $ elems p) <> char7 '\n' <> flush
  where
    findCycles :: Int -> DoState [(Int, Int)]
    findCycles i = do
      b <- S.member i <$> get
      if b then pure []
      else do
        y <- g
        pure $ zip y (tail y)
      where
        g :: DoState [Int]
        g = do
          lift $ P.putStr $ toLazyByteString $ char7 '?' <> char7 ' ' <> putInts [i] <> char7 '\n' <> flush
          nextI <- lift readIntIO
          nextB <- S.member nextI <$> get
          modify $ S.insert nextI
          if nextB then pure [nextI]
          else (nextI:)<$>g

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readInt .  P.pack <$> getLine
  replicateM_ t go

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Lazy
import qualified Control.Monad.ST as Strict
import Control.Monad.Trans.Class

solve :: forall s. S (ST s) Builder
solve = do
  ~[n] <- getInts 1
  let  lst :: Strict.ST s v -> S (ST s) v
       lst = lift . strictToLazyST
  arr :: STUArray s Int Int <- lst $ newArray (1, n) 0
  let
    query :: Int -> Builder
    query k = string7 "? " <> putInts [k] <> flush
    loopQuery :: Int -> Int -> S (ST s) Builder
    loopQuery k prev = (query k <>) <$> do
      ~[resp] <- getInts 1
      lst $ writeArray arr prev resp
      vis <- lst $ readArray arr resp
      if  vis /= 0
        then  pure mempty
        else  loopQuery k resp
    go :: Int -> S (ST s) Builder
    go k = do
      vis <- lst $ readArray arr k
      if  vis == 0
        then  (query k <>) <$> do
          ~[resp] <- getInts 1
          loopQuery k resp
        else  pure mempty
  queries <- forM [1 .. n] go
  ansArr :: UArray Int Int <- lst $ freeze arr
  let  ans = char7 '!' <> char7 ' ' <> putInts (elems ansArr)
  pure $ mconcat queries <> ans <> flush

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    state $ \st -> runST $ runStateT solve st

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

getNext :: Monad m => Int -> S m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> S m [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans.Class (lift)
import Data.Char (isSpace)
import Data.Maybe

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

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

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

readIntIO :: IO Int
readIntIO = do
  t <- getLine
  if all isSpace t then readIntIO else pure . readInt . P.pack $ t

type DoState = StateT (S.Set Int) IO

go :: IO ()
go = do
  n <- readIntIO
  cs <- flip evalStateT S.empty $ fmap (foldr (<>) []) $ mapM findCycles [1..n]
  let
    p :: UArray Int Int
    p = array (1, n) cs
  P.putStr $ toLazyByteString $ char7 '!' <> char7 ' ' <> (putInts $ elems p) <> char7 '\n' <> flush
  where
    findCycles :: Int -> DoState [(Int, Int)]
    findCycles i = do
      b <- S.member i <$> get
      if b then pure []
      else do
        y@(x:xs) <- g
        pure $ zip y (xs ++ [x])
      where
        g :: DoState [Int]
        g = do
          b <- S.member i<$>get
          if b then pure []
          else do
            lift $ P.putStr $ toLazyByteString $ char7 '?' <> char7 ' ' <> putInts [i] <> char7 '\n' <> flush
            nextI <- lift readIntIO
            modify $ S.insert nextI
            (nextI:)<$>g

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readInt .  P.pack <$> getLine
  replicateM_ t go

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans.Class (lift)
import Data.Char (isSpace)
import Data.Maybe

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

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

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

readIntIO :: IO Int
readIntIO = do
  t <- getLine
  if all isSpace t then readIntIO else pure . readInt . P.pack $ t

type DoState = StateT (S.Set Int) IO

go :: IO ()
go = do
  n <- readIntIO
  cs <- flip evalStateT S.empty $ fmap (foldr (<>) []) $ mapM findCycles [1..n]
  let
    p :: UArray Int Int
    p = array (1, n) cs
  P.putStr $ toLazyByteString $ char7 '!' <> (putInts $ elems p) <> char7 '\n' <> flush
  where
    findCycles :: Int -> DoState [(Int, Int)]
    findCycles i = do
      b <- S.member i <$> get
      if b then pure []
      else do
        y@(x:xs) <- g
        pure $ zip y (xs ++ [x])
      where
        g :: DoState [Int]
        g = do
          b <- S.member i<$>get
          if b then pure []
          else do
            lift $ P.putStr $ toLazyByteString $ char7 '?' <> putInts [i] <> char7 '\n' <> flush
            nextI <- lift readIntIO
            modify $ S.insert nextI
            (nextI:)<$>g

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readInt .  P.pack <$> getLine
  replicateM_ t go