There are $$$n$$$ emotes in very popular digital collectible card game (the game is pretty famous so we won't say its name). The $$$i$$$-th emote increases the opponent's happiness by $$$a_i$$$ units (we all know that emotes in this game are used to make opponents happy).You have time to use some emotes only $$$m$$$ times. You are allowed to use any emotion once, more than once, or not use it at all. The only restriction is that you cannot use the same emote more than $$$k$$$ times in a row (otherwise the opponent will think that you're trolling him).Note that two emotes $$$i$$$ and $$$j$$$ ($$$i \ne j$$$) such that $$$a_i = a_j$$$ are considered different.You have to make your opponent as happy as possible. Find the maximum possible opponent's happiness.

The first line of the input contains three integers $$$n, m$$$ and $$$k$$$ ($$$2 \le n \le 2 \cdot 10^5$$$, $$$1 \le k \le m \le 2 \cdot 10^9$$$) — the number of emotes, the number of times you can use emotes and the maximum number of times you may use the same emote in a row. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is value of the happiness of the $$$i$$$-th emote.

Print one integer — the maximum opponent's happiness if you use emotes in a way satisfying the problem statement.

NoteIn the first example you may use emotes in the following sequence: $$$4, 4, 5, 4, 4, 5, 4, 4, 5$$$.

import Data.List(sort)
getans m k (mx:smx:_) = mx*m - (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Integer) . words  <$> getLine
    n <- map (read :: String -> Integer) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Int) . words  <$> getLine
    n <- map (read :: String -> Int) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d


It is the hard version of the problem. The difference is that in this version, there are nodes with already chosen colors.Theofanis is starving, and he wants to eat his favorite food, sheftalia. However, he should first finish his homework. Can you help him with this problem?You have a perfect binary tree of $$$2^k - 1$$$ nodes — a binary tree where all vertices $$$i$$$ from $$$1$$$ to $$$2^{k - 1} - 1$$$ have exactly two children: vertices $$$2i$$$ and $$$2i + 1$$$. Vertices from $$$2^{k - 1}$$$ to $$$2^k - 1$$$ don't have any children. You want to color its vertices with the $$$6$$$ Rubik's cube colors (White, Green, Red, Blue, Orange and Yellow).Let's call a coloring good when all edges connect nodes with colors that are neighboring sides in the Rubik's cube.  A picture of Rubik's cube and its 2D map. More formally:   a white node can not be neighboring with white and yellow nodes;  a yellow node can not be neighboring with white and yellow nodes;  a green node can not be neighboring with green and blue nodes;  a blue node can not be neighboring with green and blue nodes;  a red node can not be neighboring with red and orange nodes;  an orange node can not be neighboring with red and orange nodes; However, there are $$$n$$$ special nodes in the tree, colors of which are already chosen.You want to calculate the number of the good colorings of the binary tree. Two colorings are considered different if at least one node is colored with a different color.The answer may be too large, so output the answer modulo $$$10^9+7$$$.

The first line contains the integers $$$k$$$ ($$$1 \le k \le 60$$$) — the number of levels in the perfect binary tree you need to color. The second line contains the integer $$$n$$$ ($$$1 \le n \le \min(2^k - 1, 2000)$$$) — the number of nodes, colors of which are already chosen. The next $$$n$$$ lines contains integer $$$v$$$ ($$$1 \le v \le 2^k - 1$$$) and string $$$s$$$ — the index of the node and the color of the node ($$$s$$$ is one of the white, yellow, green, blue, red and orange). It is guaranteed that each node $$$v$$$ appears in the input at most once.

Print one integer — the number of the different colorings modulo $$$10^9+7$$$.

NoteIn the picture below, you can see one of the correct colorings of the first test example.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

--module CF1594E2 where

import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu -- Lazy.Builder deprecated
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import Data.Bits
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

type St = StateT [B8.ByteString] Identity

numberOfTestcases :: St [Int]
numberOfTestcases = implicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

data Input = Input { k::Integer, vcs::[[Integer]]}
type Output = Integer --deriving Show

fastPow :: Integral t=>(t->t)->t->t->t
fastPow modf base power = ans where
  expo = base : map (modf.(^2)) expo
  prefix = power : map (`div` 2) prefix
  bits = map (`mod` 2) prefix
  ans = foldl1 (\a b->modf $ a*b) $ take 64 $ zipWith (^) expo bits

modp :: Integral t=>t->t
modp = (`mod` (10^9+7))

data Coloring = Self {color:: Integer, perm:: Integer}
              | Kid {color:: Integer, perm:: Integer} deriving Show

colorCompose :: Coloring -> Coloring -> Coloring
colorCompose (Self c x) (Kid c' y)
  | c == c' = Self c 0
  | otherwise = Self c (modp $ x*y)
colorCompose (Self c x) (Self c' y)
  | c /= c' = Self c 0
  | otherwise = Self c (modp $ x*y)

colorsCompose :: [Coloring] -> [Coloring] -> [Coloring]
colorsCompose cs1 cs2 = map aggregate $ groupByColor opResults where
  opResults = colorCompose <$> cs1 <*> cs2
  groupByColor = L.groupBy ((==) `on` color) . L.sortBy (compare `on` color)
  aggregate group = Self (color $ head group) (sum $ map perm group)

colorSum :: [Coloring] -> Integer
colorSum colorings = sum $ map (\(Self _ x)->x) colorings

encode :: Integer -> [Coloring]
encode b = [Self c (if c==b then 1 else 0) | c<-[0,1,2]]

getPerm :: S.Set Integer -> M.Map Integer [Coloring] -> [Coloring]
getPerm inpath vcmap = dpf 1 where
  dpf v = fromMaybe [Self 0 0] $ M.lookup v dp
  dp = M.fromSet f inpath
  f v = let
    self = fromMaybe [Self 0 2, Self 1 2, Self 2 2] $ M.lookup v vcmap
    kids = (map (\(Self c x)->(Kid c x)).dpf) <$> kidsNums v
    kidsNums v = filter inway [2*v,2*v+1]
    inway x = S.member x inpath
    in
     foldl1 colorsCompose $ self:kids

addWhileNew :: Ord a => [a] -> S.Set a -> S.Set a
addWhileNew [] set = set
addWhileNew (x:xs) set
  | S.member x set = set
  | otherwise = addWhileNew xs $ S.insert x set

solve :: Input -> Output
solve (Input k vcs) = modp $ fixedPerm vcs * restPerm k vcs where
  vcmap = M.fromList . fmap (\[v,c]->(v,encode $ fromIntegral c))
  ancestors v = v : map (`div` 2) (ancestors v)
  ancestorss vcs'= map (takeWhile (/=0).ancestors) (M.keys $ vcmap vcs')
  inpath vcs' = foldr addWhileNew S.empty $ ancestorss vcs'
  fixedPerm vcs' = colorSum $ getPerm (inpath vcs') (vcmap vcs')
  totalNodes k' = (fastPow id 2 k') - 1
  fixedNodes vcs'= fromIntegral $ S.size (inpath vcs')
  restCount k' vcs'= (totalNodes k') - (fixedNodes vcs')
  restPerm k' vcs' = fastPow modp 4  (restCount k' vcs')

getvc :: StateT [B8.ByteString] Identity [Integer]
getvc = do
  ~[v] <- getIntegrals 1
  s <- state getNext
  let colors = flip zip [0..] $ B8.pack <$> ["white", "yellow", "green", "blue", "red", "orange"]
  let ~(Just c) = lookup s colors
  return [v,c`div`2]

input :: StateT [B8.ByteString] Identity Input
input = do
  ~[k,n] <- getIntegrals 2
  vcs <- replicateM (fromIntegral n :: Int) getvc
  return $ Input k vcs

output :: Output -> Bu.Builder
output x = Bu.integerDec x <> nl where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

doTestcase :: StateT [B8.ByteString] Identity Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> StateT [B8.ByteString] Identity [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs


During the programming classes Vasya was assigned a difficult problem. However, he doesn't know how to code and was unable to find the solution in the Internet, so he asks you to help.You are given a sequence $$$a$$$, consisting of $$$n$$$ distinct integers, that is used to construct the binary search tree. Below is the formal description of the construction process.  First element $$$a_1$$$ becomes the root of the tree.  Elements $$$a_2, a_3, \ldots, a_n$$$ are added one by one. To add element $$$a_i$$$ one needs to traverse the tree starting from the root and using the following rules:   The pointer to the current node is set to the root.  If $$$a_i$$$ is greater than the value in the current node, then its right child becomes the current node. Otherwise, the left child of the current node becomes the new current node.  If at some point there is no required child, the new node is created, it is assigned value $$$a_i$$$ and becomes the corresponding child of the current node.

The first line of the input contains a single integer $$$n$$$ ($$$2 \leq n \leq 100\,000$$$) — the length of the sequence $$$a$$$. The second line contains $$$n$$$ distinct integers $$$a_i$$$ ($$$1 \leq a_i \leq 10^9$$$) — the sequence $$$a$$$ itself.

Output $$$n - 1$$$ integers. For all $$$i > 1$$$ print the value written in the node that is the parent of the node with value $$$a_i$$$ in it.

import qualified Data.Set as Set

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

getVal :: (Set.Set (Int, Int) -> (Int, Int)) -> Set.Set (Int, Int) -> (Int, Int)
getVal f s | Set.null s = (-1, -1)
           | otherwise = f s

getMin :: Set.Set (Int, Int) -> (Int, Int)
getMin = getVal Set.findMin

getMax :: Set.Set (Int, Int) -> (Int, Int)
getMax = getVal Set.findMax

solve :: [Int] -> [Int]
solve (a:ax) = solve' 1 ax (Set.singleton (a, 0))
    where solve' :: Int -> [Int] -> Set.Set (Int, Int) -> [Int]
          solve' _ [] _ = []
          solve' i (a:ax) s = let (l, r) = Set.split (a, 0) s
                                  (lv, lt) = getMax l
                                  (rv, rt) = getMin r
                                  next_s = Set.insert (a, i) s
                              in if lt > rt
                                 then lv:solve' (i + 1) ax next_s
                                 else rv:solve' (i + 1) ax next_s


Vasya has a multiset $$$s$$$ consisting of $$$n$$$ integer numbers. Vasya calls some number $$$x$$$ nice if it appears in the multiset exactly once. For example, multiset $$$\{1, 1, 2, 3, 3, 3, 4\}$$$ contains nice numbers $$$2$$$ and $$$4$$$.Vasya wants to split multiset $$$s$$$ into two multisets $$$a$$$ and $$$b$$$ (one of which may be empty) in such a way that the quantity of nice numbers in multiset $$$a$$$ would be the same as the quantity of nice numbers in multiset $$$b$$$ (the quantity of numbers to appear exactly once in multiset $$$a$$$ and the quantity of numbers to appear exactly once in multiset $$$b$$$).

The first line contains a single integer $$$n~(2 \le n \le 100)$$$. The second line contains $$$n$$$ integers $$$s_1, s_2, \dots s_n~(1 \le s_i \le 100)$$$ — the multiset $$$s$$$.

If there exists no split of $$$s$$$ to satisfy the given requirements, then print "NO" in the first line. Otherwise print "YES" in the first line. The second line should contain a string, consisting of $$$n$$$ characters. $$$i$$$-th character should be equal to 'A' if the $$$i$$$-th element of multiset $$$s$$$ goes to multiset $$$a$$$ and 'B' if if the $$$i$$$-th element of multiset $$$s$$$ goes to multiset $$$b$$$. Elements are numbered from $$$1$$$ to $$$n$$$ in the order they are given in the input. If there exist multiple solutions, then print any of them.

{-# 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 qualified Data.IntMap as IM
import Data.Ratio
import Control.Monad.State
import Data.Array.IO.Safe

readIntBS = fst . fromJust . BS.readInt

main = do
  n <- readLn :: IO Int
  xs <- map read . words <$> getLine :: IO [Int]

  let
    ys = (map length . group . sort) xs
    cnt1 = length . filter (==1) $ ys
    cntGE3 = length . filter (>=3) $ ys
    im = IM.fromList . (map (\list -> (head list, length list)) . group . sort) $ xs

  if even cnt1 || (odd cnt1 && cntGE3 > 0) then do
    putStrLn "YES"
    let m = ceiling (cnt1 % 2)

    arr <- newArray (0,n-1) '.' :: IO (IOUArray Int Char)

    let (a,b) = splitAt m (IM.toList . IM.filter (==1) $ im)

    forM_ a $ \(x,_) -> writeArray arr (fromJust . elemIndex x $ xs) 'A'
    forM_ b $ \(x,_) -> writeArray arr (fromJust . elemIndex x $ xs) 'B'

    when (odd cnt1) $ do
      let p = head . IM.toList . IM.filter (>=3) $ im
      writeArray arr (fromJust . elemIndex (fst p) $ xs) 'B'

    forM_ [0..n-1] $ \i -> do
      x <- readArray arr i
      when (x == '.') $ writeArray arr i 'A'

    putStrLn =<< getElems arr

    else
    putStrLn "NO"


There are $$$n$$$ warriors in a row. The power of the $$$i$$$-th warrior is $$$a_i$$$. All powers are pairwise distinct.You have two types of spells which you may cast:   Fireball: you spend $$$x$$$ mana and destroy exactly $$$k$$$ consecutive warriors;  Berserk: you spend $$$y$$$ mana, choose two consecutive warriors, and the warrior with greater power destroys the warrior with smaller power. For example, let the powers of warriors be $$$[2, 3, 7, 8, 11, 5, 4]$$$, and $$$k = 3$$$. If you cast Berserk on warriors with powers $$$8$$$ and $$$11$$$, the resulting sequence of powers becomes $$$[2, 3, 7, 11, 5, 4]$$$. Then, for example, if you cast Fireball on consecutive warriors with powers $$$[7, 11, 5]$$$, the resulting sequence of powers becomes $$$[2, 3, 4]$$$.You want to turn the current sequence of warriors powers $$$a_1, a_2, \dots, a_n$$$ into $$$b_1, b_2, \dots, b_m$$$. Calculate the minimum amount of mana you need to spend on it.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the length of sequence $$$a$$$ and the length of sequence $$$b$$$ respectively. The second line contains three integers $$$x, k, y$$$ ($$$1 \le x, y, \le 10^9; 1 \le k \le n$$$) — the cost of fireball, the range of fireball and the cost of berserk respectively. The third line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$). It is guaranteed that all integers $$$a_i$$$ are pairwise distinct. The fourth line contains $$$m$$$ integers $$$b_1, b_2, \dots, b_m$$$ ($$$1 \le b_i \le n$$$). It is guaranteed that all integers $$$b_i$$$ are pairwise distinct.

Print the minimum amount of mana for turning the sequnce $$$a_1, a_2, \dots, a_n$$$ into $$$b_1, b_2, \dots, b_m$$$, or $$$-1$$$ if it is impossible.

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

import Data.List
import Data.Maybe

main = do
  getLine
  [x, k, y] <- map read . words <$> getLine
  as <- (0 :) . (++ [-1]) . map read . words <$> getLine
  bs <- (0 :) . (++ [-1]) . map read . words <$> getLine
  print $ fromMaybe (- 1) $ solve x k y as bs

solve x k y (al : ars) (bl : bs@(br : _))
  | al /= bl || null as || null costs = Nothing
  | otherwise = (minimum costs +) <$> solve x k y as bs
  where
    (range, as) = span (/= br) ars
    len = genericLength range
    costs = [y * len | maximum (0 : range) < max bl br] ++ concat [[x + y * (len - k), x * (len `div` k) + y * (len `mod` k)] | len >= k]
solve _ _ _ _ _ = Just 0


A permutation is a sequence of $$$n$$$ integers from $$$1$$$ to $$$n$$$, in which all numbers occur exactly once. For example, $$$[1]$$$, $$$[3, 5, 2, 1, 4]$$$, $$$[1, 3, 2]$$$ are permutations, and $$$[2, 3, 2]$$$, $$$[4, 3, 1]$$$, $$$[0]$$$ are not.Polycarp was presented with a permutation $$$p$$$ of numbers from $$$1$$$ to $$$n$$$. However, when Polycarp came home, he noticed that in his pocket, the permutation $$$p$$$ had turned into an array $$$q$$$ according to the following rule:   $$$q_i = \max(p_1, p_2, \ldots, p_i)$$$. Now Polycarp wondered what lexicographically minimal and lexicographically maximal permutations could be presented to him.An array $$$a$$$ of length $$$n$$$ is lexicographically smaller than an array $$$b$$$ of length $$$n$$$ if there is an index $$$i$$$ ($$$1 \le i \le n$$$) such that the first $$$i-1$$$ elements of arrays $$$a$$$ and $$$b$$$ are the same, and the $$$i$$$-th element of the array $$$a$$$ is less than the $$$i$$$-th element of the array $$$b$$$. For example, the array $$$a=[1, 3, 2, 3]$$$ is lexicographically smaller than the array $$$b=[1, 3, 4, 2]$$$.For example, if $$$n=7$$$ and $$$p=[3, 2, 4, 1, 7, 5, 6]$$$, then $$$q=[3, 3, 4, 4, 7, 7, 7]$$$ and the following permutations could have been as $$$p$$$ initially:   $$$[3, 1, 4, 2, 7, 5, 6]$$$ (lexicographically minimal permutation);  $$$[3, 1, 4, 2, 7, 6, 5]$$$;  $$$[3, 2, 4, 1, 7, 5, 6]$$$;  $$$[3, 2, 4, 1, 7, 6, 5]$$$ (lexicographically maximum permutation). For a given array $$$q$$$, find the lexicographically minimal and lexicographically maximal permutations that could have been originally presented to Polycarp.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases 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 $$$n$$$ integers $$$q_1, q_2, \ldots, q_n$$$ ($$$1 \le q_i \le n$$$). It is guaranteed that the array $$$q$$$ was obtained by applying the rule from the statement to some permutation $$$p$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output two lines:    on the first line output $$$n$$$ integers — lexicographically minimal permutation that could have been originally presented to Polycarp;  on the second line print $$$n$$$ integers — lexicographically maximal permutation that could have been originally presented to Polycarp;

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort)
import Data.Maybe (fromJust, fromMaybe)

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

testCase :: Scanner String
testCase = do
  xs <- numberOf int
  return . unlines . map (unwords . map show) $ [minP xs, maxP xs]

maxP, minP :: [Int] -> [Int]
maxP = reverse . (\(ps, _, _) -> ps) . foldl nxt ([], 0, [])
  where
    nxt (ps, u, cs) v
      | u == v = let (c : cs') = cs in (c : ps, u, cs')
      | otherwise = (v : ps, v, reverse [u + 1 .. v - 1] ++ cs)

minP = reverse . (\(ps, _, _) -> ps) . foldl nxt ([], 0, newQueue)
  where
    nxt (ps, u, cs) v
      | u == v = let (c, cs') = popQ cs in (c : ps, u, cs')
      | otherwise = (v : ps, v, foldl (flip pushQ) cs [u + 1 .. v - 1])

--- Template ---
data Queue a = Queue [a] [a]

newQueue :: Queue a
newQueue = Queue [] []

pushQ :: a -> Queue a -> Queue a
pushQ x (Queue hs ts) = Queue hs (x : ts)

emptyQ :: Queue a -> Bool
emptyQ (Queue hs ts) = null hs && null ts

popQ :: Queue a -> (a, Queue a)
popQ (Queue [] ts) = let (h : hs) = reverse ts in (h, Queue hs [])
popQ (Queue (h : hs) ts) = (h, Queue hs ts)

safePopQ :: Queue a -> Queue a
safePopQ q = if emptyQ q then q else snd (popQ q)

frontQ :: Queue a -> a
frontQ = fst . popQ

safeFrontQ :: Queue a -> Maybe a
safeFrontQ q = if emptyQ q then Nothing else Just (frontQ q)

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

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

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

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
  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 (,)


To celebrate your birthday you have prepared a festive table! Now you want to seat as many guests as possible.The table can be represented as a rectangle with height $$$h$$$ and width $$$w$$$, divided into $$$h \times w$$$ cells. Let $$$(i, j)$$$ denote the cell in the $$$i$$$-th row and the $$$j$$$-th column of the rectangle ($$$1 \le i \le h$$$; $$$1 \le j \le w$$$).Into each cell of the table you can either put a plate or keep it empty.As each guest has to be seated next to their plate, you can only put plates on the edge of the table — into the first or the last row of the rectangle, or into the first or the last column. Formally, for each cell $$$(i, j)$$$ you put a plate into, at least one of the following conditions must be satisfied: $$$i = 1$$$, $$$i = h$$$, $$$j = 1$$$, $$$j = w$$$.To make the guests comfortable, no two plates must be put into cells that have a common side or corner. In other words, if cell $$$(i, j)$$$ contains a plate, you can't put plates into cells $$$(i - 1, j)$$$, $$$(i, j - 1)$$$, $$$(i + 1, j)$$$, $$$(i, j + 1)$$$, $$$(i - 1, j - 1)$$$, $$$(i - 1, j + 1)$$$, $$$(i + 1, j - 1)$$$, $$$(i + 1, j + 1)$$$.Put as many plates on the table as possible without violating the rules above.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Each of the following $$$t$$$ lines describes one test case and contains two integers $$$h$$$ and $$$w$$$ ($$$3 \le h, w \le 20$$$) — the height and the width of the table.

For each test case, print $$$h$$$ lines containing $$$w$$$ characters each. Character $$$j$$$ in line $$$i$$$ must be equal to $$$1$$$ if you are putting a plate into cell $$$(i, j)$$$, and $$$0$$$ otherwise. If there are multiple answers, print any. All plates must be put on the edge of the table. No two plates can be put into cells that have a common side or corner. The number of plates put on the table under these conditions must be as large as possible. You are allowed to print additional empty lines.

NoteFor the first test case, example output contains the only way to put $$$6$$$ plates on the table.For the second test case, there are many ways to put $$$4$$$ plates on the table, example output contains one of them.Putting more than $$$6$$$ plates in the first test case or more than $$$4$$$ plates in the second test case is impossible.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

llines :: Int -> Int -> Int -> [String]
llines h w curr
  | curr == 0 = line : llines h w (curr+1)
  | curr == h - 1 = [line]
  | otherwise = (if odd curr || curr == h - 2 then replicate w '0' else "1" ++ replicate (w-2) '0' ++ "1") : llines h w (curr+1)
    where evenline = foldl (++) "" $ replicate (div w 2) "10"
          oddline = evenline ++ "1"
          line = if even w then evenline else oddline

solve :: IO ()
solve = do
  s <- getLine
  let [h, w] = map read $ words s :: [Int]
      rect = llines h w 0
    in putStrLn $ intercalate "\n" rect

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

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    [h, w] <- getIntList
    let ans = getAnswer h w 1
    forM_ ans putStrLn
    putChar '\n'

getFirstAndLast :: Int -> String
getFirstAndLast w = take w $ cycle "10"

getAnswer :: Int -> Int -> Int -> [String]
getAnswer h w i
    | i == h         = [getFirstAndLast w]
    | i == 1         = getFirstAndLast w : getAnswer h w (i + 1)
    | i == h - 1     = emptyLine : getAnswer h w (i + 1)
    | i `mod` 2 == 0 = emptyLine : getAnswer h w (i + 1)
    | otherwise      = setLine : getAnswer h w (i + 1)
    where emptyLine = take w $ repeat '0'
          setLine   = "1" ++ (take (w - 2) $ repeat '0') ++ "1"

-- 101001
-- 000000
-- 100001
-- 000000
-- 100000
-- 001010

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

import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

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

testCase :: Scanner String
testCase = unlines . solve <$> pair int int

type Grid = [[Char]]

solve :: (Int, Int) -> Grid
solve (h, w) = [[if ok i j then '1' else '0' | j <- [1 .. w]] | i <- [1 .. h]]
  where
    ok i j
      | i == 1 = odd j
      | i == h = odd j && h >= 3
      | otherwise = odd i && i + 2 <= h && (j == 1 || j == w)

-------------------------- 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 (,)


During the hypnosis session, Nicholas suddenly remembered a positive integer $$$n$$$, which doesn't contain zeros in decimal notation. Soon, when he returned home, he got curious: what is the maximum number of digits that can be removed from the number so that the number becomes not prime, that is, either composite or equal to one?For some numbers doing so is impossible: for example, for number $$$53$$$ it's impossible to delete some of its digits to obtain a not prime integer. However, for all $$$n$$$ in the test cases of this problem, it's guaranteed that it's possible to delete some of their digits to obtain a not prime number.Note that you cannot remove all the digits from the number.A prime number is a number that has no divisors except one and itself. A composite is a number that has more than two divisors. $$$1$$$ is neither a prime nor a composite number.

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 10^3$$$), denoting the number of test cases. Description of the test cases follows. The first line of each test case contains one positive integer $$$k$$$ ($$$1 \le k \le 50$$$) — the number of digits in the number. The second line of each test case contains a positive integer $$$n$$$, which doesn't contain zeros in decimal notation ($$$10^{k-1} \le n < 10^{k}$$$). It is guaranteed that it is always possible to remove less than $$$k$$$ digits to make the number not prime. It is guaranteed that the sum of $$$k$$$ over all test cases does not exceed $$$10^4$$$.

For every test case, print two numbers in two lines. In the first line print the number of digits, that you have left in the number. In the second line print the digits left after all delitions.  If there are multiple solutions, print any.

NoteIn the first test case, you can't delete $$$2$$$ digits from the number $$$237$$$, as all the numbers $$$2$$$, $$$3$$$, and $$$7$$$ are prime. However, you can delete $$$1$$$ digit, obtaining a number $$$27 = 3^3$$$.In the second test case, you can delete all digits except one, as $$$4 = 2^2$$$ is a composite number.

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

isEvenChar '1' = True
isEvenChar '4' = True
isEvenChar '6' = True
isEvenChar '8' = True
isEvenChar '9' = True
isEvenChar _ = False

calc1 :: String -> Maybe String
calc1 x = do
  letter <- find isEvenChar x
  return $ [letter]

calc2 :: String -> Maybe String
calc2 (a:'2':xs) = Just (a:['2'])
calc2 (a:'5':xs) = Just (a:['5'])
calc2 (a:b:xs) | a == b = Just (a:[b])
calc2 (a:b:c:xs) | a == c = Just (a:[c])
calc2 ('2':'3':'7':xs) = Just ('2':['7'])
calc2 ('2':'7':xs) = Just ('2':['7'])
calc2 ('5':'3':'7':xs) = Just ('5':['7'])
calc2 ('5':'7':xs) = Just ('5':['7'])
calc2 (a:b:c:xs) = calc2 (b:c:xs)
calc2 _ | otherwise = Nothing

(<||>) :: (Monoid a, Eq a) => a -> a -> a
x <||> y
     | x == mempty = y
     | True = x

-- 77, 33
calc3 :: Char -> String -> Maybe String
calc3 ch x =
  let count = foldr (\a b -> if a == ch then (b+1) else b) 0 x in
    if count >= 2 then Just (ch:[ch])
    else Nothing

calc :: String -> Maybe String
calc a = (calc1 a) <||> (calc2 a ) <||> (calc3 '7' a) <||> (calc3 '3' a)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let k = read line :: Int
    line <- getLine
    let ans1 = calc line
    --print line
    let ans = fromJust ans1
    print $ length ans
    putStrLn ans

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

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

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "14689") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

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 (,)

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

import Data.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) twoDigits of
                       y : _ -> show y
                       []    -> error "oops"
  where
    twoDigits = map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s

module Main where

import Data.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) (map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)) of
                       y : _ -> show y
                       []    -> error "oops"

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s
      -- showAns s = unlines [show (length s), s]

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

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

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "1468") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

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 (,)

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


Let's call the following process a transformation of a sequence of length $$$n$$$.If the sequence is empty, the process ends. Otherwise, append the greatest common divisor (GCD) of all the elements of the sequence to the result and remove one arbitrary element from the sequence. Thus, when the process ends, we have a sequence of $$$n$$$ integers: the greatest common divisors of all the elements in the sequence before each deletion.You are given an integer sequence $$$1, 2, \dots, n$$$. Find the lexicographically maximum result of its transformation.A sequence $$$a_1, a_2, \ldots, a_n$$$ is lexicographically larger than a sequence $$$b_1, b_2, \ldots, b_n$$$, if there is an index $$$i$$$ such that $$$a_j = b_j$$$ for all $$$j < i$$$, and $$$a_i > b_i$$$.

The first and only line of input contains one integer $$$n$$$ ($$$1\le n\le 10^6$$$).

Output $$$n$$$ integers  — the lexicographically maximum result of the transformation.

NoteIn the first sample the answer may be achieved this way:  Append GCD$$$(1, 2, 3) = 1$$$, remove $$$2$$$.  Append GCD$$$(1, 3) = 1$$$, remove $$$1$$$.  Append GCD$$$(3) = 3$$$, remove $$$3$$$. We get the sequence $$$[1, 1, 3]$$$ as the result.

solve 1 = [1]
solve 2 = [1,2]
solve 3 = [1,1,3]
solve n = replicate ((n+1)`div`2) 1 ++ map (*2) (solve (n`div`2))

main = do
  n <- readLn :: IO Int
  putStrLn $ unwords . map show $ solve n


An array $$$b$$$ of length $$$k$$$ is called good if its arithmetic mean is equal to $$$1$$$. More formally, if $$$$$$\frac{b_1 + \cdots + b_k}{k}=1.$$$$$$Note that the value $$$\frac{b_1+\cdots+b_k}{k}$$$ is not rounded up or down. For example, the array $$$[1,1,1,2]$$$ has an arithmetic mean of $$$1.25$$$, which is not equal to $$$1$$$.You are given an integer array $$$a$$$ of length $$$n$$$. In an operation, you can append a non-negative integer to the end of the array. What's the minimum number of operations required to make the array good?We have a proof that it is always possible with finitely many operations.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the length of the initial array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1,\ldots,a_n$$$ ($$$-10^4\leq a_i \leq 10^4$$$), the elements of the array.

For each test case, output a single integer — the minimum number of non-negative integers you have to append to the array so that the arithmetic mean of the array will be exactly $$$1$$$.

NoteIn the first test case, we don't need to add any element because the arithmetic mean of the array is already $$$1$$$, so the answer is $$$0$$$.In the second test case, the arithmetic mean is not $$$1$$$ initially so we need to add at least one more number. If we add $$$0$$$ then the arithmetic mean of the whole array becomes $$$1$$$, so the answer is $$$1$$$.In the third test case, the minimum number of elements that need to be added is $$$16$$$ since only non-negative integers can be added.In the fourth test case, we can add a single integer $$$4$$$. The arithmetic mean becomes $$$\frac{-2+4}{2}$$$ which is equal to $$$1$$$.

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) (words s)
            n = read ns :: Integer
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Integer)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) (words s)
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            sm = sum a
            n = read ns :: Int
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
    print $ if s >= n then s - n else 1

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

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    s <- sum <$> getInts
    if s < k then
      print 1
    else
      print $ s - k

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    a <- getInts
    let s = sum a
    if s < k then
      print 1
    else
      print $ s - k

module Main where

(|>) = flip ($)

chunksOf :: Int -> [a] -> [[a]]
chunksOf n [] = []
chunksOf n xs = take n xs : chunksOf n (drop n xs)

solve :: [Int] -> Int
solve a =
    if sum a >= length a
       then (sum a) - (length a)
       else 1

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

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]
printS = do
    n <- readLn::IO Int
    aa <- readInts
    let s = sum aa
    print $ if s>=n then s-n else 1
main = do
    t <- readLn::IO Int
    replicateM_ t printS

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [k] <- getInts
    s <- sum <$> getInts
    let
      result = case compare s k of
        GT -> s - k
        LT -> 1
        EQ -> 0
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        a <- map parseInt . BS.words <$> BS.getLine
        let s = sum a
        if n == s then
            putStrLn "0"
        else if n > s then
            putStrLn "1"
        else
            print $ s - n

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else 1

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

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else l + 1

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

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    print $ abs (sum a) - length a

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


Roma (a popular Russian name that means 'Roman') loves the Little Lvov Elephant's lucky numbers.Let us remind you that lucky numbers are positive integers whose decimal representation only contains lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Roma's got n positive integers. He wonders, how many of those integers have not more than k lucky digits? Help him, write the program that solves the problem.

The first line contains two integers n, k (1 ≤ n, k ≤ 100). The second line contains n integers ai (1 ≤ ai ≤ 109) — the numbers that Roma has.  The numbers in the lines are separated by single spaces.

In a single line print a single integer — the answer to the problem.

NoteIn the first sample all numbers contain at most four lucky digits, so the answer is 3.In the second sample number 447 doesn't fit in, as it contains more than two lucky digits. All other numbers are fine, so the answer is 2.

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

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

ok :: Int -> String -> Bool
ok k a = count47 a <= k
	where
		count47 :: String -> Int
		count47 = length . filter ( \c -> c == '4' || c == '7' )

main = interact $ show . solve . words

solve (n : kk : a) = length . filter ((<=k) . length . filter (`elem` "47")) $ a
                    where k = read kk

import Data.List

lucky x = x == '4' || x == '7'

findLucky k [] = 0
findLucky k (a:ais) =
    let l = length $ (findIndices lucky a)
    in if l > k then findLucky k ais else 1 + findLucky k ais

main :: IO ()
main = do
    nm <- getLine
    let [_, k] = map read $ words nm
    ais <- getLine
    let a = words ais
    print $ findLucky k a

import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: Int -> [String] -> Int
solve k  =  length . filter happyDigitsLessK
  where
    happyDigitsLessK  =  (<= k) . length . filter isHappyDigit
    isHappyDigit c  =  c == '4' || c == '7'

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs  <-  liftM words getLine
    print $ solve k xs

import Prelude

main = do
	str <- getContents
	print $ solve str

solve :: String -> Int
solve str = length $ filter (<=k) $ ln
	where
		(ns:ks:a) = words str
		n = read ns
		k =  read ks
		aa = take n a
		ln = map toLucky aa
		toLucky number = length $ filter (\chr -> (chr == '7') || (chr == '4')) $ number

g s c = length $ filter (==c) s
f s = sum $ map (g s) "47"
t (k:s) = length $ filter (<=read k) $ map f s
main = interact $ show . t . tail . words

main :: IO ()
main = do
  nkLine <- getLine
  intLine <- getLine
  let
    k = read $ last $ words nkLine
    intVals = words intLine
    lengths = map length $ map (filter (\x -> x == '4' || x == '7')) intVals
    numLuckies = length $ filter (<= k) lengths
    in
   print numLuckies

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

solve :: [Int] -> Int
solve (k:as) = length [ () | a <- as, length (filter (`elem`"47") (show a)) <= k ]
solve _ = undefined

main = interact $ show . solve . tail . words
solve (k:as) = length $ filter ((<= read k) . length . filter (`elem` "47")) as

main=interact$show.f.words
f(_:k:x)=l[y|y<-x,l(filter(`elem`"47")y)<=read k]
l=length

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show . length . filter (<=k) . map f $ words a
  where
    f = length . filter (\x -> x=='4' || x=='7')
    k = read . head . tail . words $ m

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let [_, k] = map read $ words nkStr
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if checkHappyDigits num k then a+1 else a) 0 nums

module Main where
import Data.Char
import Data.List.Split

strToInt :: String -> Int
strToInt = helper 0
	where
		helper acc [] = acc
		helper acc (x:xs) = helper (acc * 10 - 48 + ord x) xs

fits :: Int -> String -> Int
fits k s = helper s 0
	where
		helper [] acc | acc > k = 0
			      | otherwise = 1
		helper (x:xs) acc | x == '4' || x == '7' = helper xs (acc + 1)
				  | otherwise = helper xs acc

toInts :: String -> [Int]
toInts = map strToInt . filter (/="") . splitOn " "

process :: String -> String -> String
process par = show . sum . map (fits k) . splitOn " "
	where
		(n:k:xs) = toInts par

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

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         n = nk!!0
         k = nk!!1
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if (checkHappyDigits num k) then (a+1) else a) 0 nums

import Control.Applicative
import Data.List

main= do
	[n,k]<- map read . words<$> getLine ::IO [Int]
	s<- words <$> getLine
	print $ length $ filter (<=k) $ map (length. filter (\z-> elem z "47") ) s

process :: Int -> [String] -> Int
process k = length . filter f
    where f = (<=k) . length . filter (\x -> x `elem` "47")

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,k] <- fmap (map readInt.words) getLine
    xs <- fmap words getLine
    print $ process k xs

main = do
    [n, k] <- fmap (map read . words) getLine :: IO [Int]
    a <- fmap words getLine :: IO [String]
    print $ length $ filter (<= k) $ map f a where
        f [] = 0
        f (x:xs)
            | x == '4' || x == '7' = 1 + f xs
            | otherwise            = f xs

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.IntMap as IntMap
import Data.List

solve k num =
  (lucky num) > k
  where lucky n = length $ filter (\d -> (d == 4) || (d == 7)) $ map (`mod` 10)
                   $ takeWhile (> 0) $ iterate (`div`10) n
main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let Just (k, r2) = readInt r1
     let Just (numbers, r3) = readIntList n r2
     let tSeq = length $ filter (\x -> x == False) $ map (solve k) numbers
     putStr $ show tSeq ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (number, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return ((number : l, t))

import Control.Applicative
main = do
    [n,k] <- map read . words <$> getLine
    ns <- take n . words <$> getContents
    let
        ans = length $ filter (<=k) $ map toNumberOfLucky $ ns
        toNumberOfLucky word = length $ filter (\c -> c=='4'||c=='7') $ word
    print ans

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: Int -> [String] -> Int
solve k = length . filter (ok k)

ok :: Int -> String -> Bool
ok k = (<= k). length . filter (`elem` "47")

-- Shit
main :: IO ()
main = do
        [[_,k], as]  <- readShit
        printShit $ solve (read k) as

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: x -> x -> Bool-> x
iif a b c = if c then a else b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit String where
    printShit = putStrLn
    printShitV = putStrLn
    readShit = getLine

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

luckyDigits :: String -> Int
luckyDigits xs = length $ filter (\x -> x == '4' || x == '7') xs

solve :: Int -> [String] -> Int
solve k xs = length $ filter (\x -> luckyDigits x <= k) xs

parseInput :: String -> (Int, [String])
parseInput input = (k, xs) where
    ls = lines input
    k = read $ last $ words $ head ls
    xs = words $ last ls

main = do
    input <- getContents
    let (k, xs) = parseInput input
    print $ solve k xs

main=interact$show.f.map read.words
f(n:k:x)=l[y|y<-x,l(show y)<=k]
l=length


Unfortunately, Vasya can only sum pairs of integers (a, b), such that for any decimal place at least one number has digit 0 in this place. For example, Vasya can sum numbers 505 and 50, but he cannot sum 1 and 4.Vasya has a set of k distinct non-negative integers d1, d2, ..., dk.Vasya wants to choose some integers from this set so that he could sum any two chosen numbers. What maximal number of integers can he choose in the required manner?

The first input line contains integer k (1 ≤ k ≤ 100) — the number of integers. The second line contains k distinct space-separated integers d1, d2, ..., dk (0 ≤ di ≤ 100).

In the first line print a single integer n the maximum number of the chosen integers. In the second line print n distinct non-negative integers — the required integers. If there are multiple solutions, print any of them. You can print the numbers in any order.

main :: IO ()
main = interact $ unlines . map unwords . solve . words

solve :: [String] -> [[String]]
solve (_ : ds) = [[show $ length ans], ans]
  where
  ans
    | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
    | otherwise = d0 ++ d1 ++ d2 ++ d3
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

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

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

solve :: [Int] -> [Int]
solve as
    | null maybe1_9 && null maybe10_90  =  concat [maybe0, maybe1_99, maybe100]
    | otherwise  =  concat [maybe0, maybe1_9, maybe10_90, maybe100]
  where
    maybe0  =  take 1 $ filter (==0) as
    maybe100  =  take 1 $ filter (== 100) as
    maybe1_9  =  take 1 $ filter (\x -> 1 <= x && x <= 9) as
    maybe10_90  =  take 1 $ filter ((== 0) . flip mod 10) $ filter (\x -> 1 <= x && x <= 99) as
    maybe1_99  =  take 1 $ filter (/= 0) $ filter (/= 100) as

prints :: Show a => [a] -> IO ()
prints as  =  do
    print $ length as
    putStrLn $ intercalate " " $ map show as

main :: IO ()
main  =  getLine >> reads >>= prints . solve

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (\x->0<x&&x<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

takeFirst :: [String] -> [String]
takeFirst [] = []
takeFirst (x : xs) = [x]

transTo01 :: String -> String
transTo01 [] = []
transTo01 (x : xs) = (if x == '0' then '0' else '1') : (transTo01 xs)

handle :: [String] -> [[String]]
handle (_ : xs) = [[show $ length res], res]
    where
    res
        | null $ x1 ++ x10 = x0 ++ x11 ++ x100
        | otherwise        = x0 ++ x1 ++ x10 ++ x100
    x0   = take 1 [x | x <- xs, transTo01 x == "0"  ]
    x1   = take 1 [x | x <- xs, transTo01 x == "1"  ]
    x10  = take 1 [x | x <- xs, transTo01 x == "10" ]
    x11  = take 1 [x | x <- xs, transTo01 x == "11" ]
    x100 = take 1 [x | x <- xs, transTo01 x == "100"]

main :: IO ()
main = interact $ unlines . map unwords . handle . words

main :: IO ()
main = interact $ unwords . solve . words

solve :: [String] -> [String]
solve (_ : ds)
  | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
  | otherwise = d0 ++ d1 ++ d2 ++ d3
  where
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null zs = [[length ys],ys]
  | otherwise = [[1+length ys],(zs!!0):ys]
   where
     ys = filter(elem '0'.show) xs
     zs = filter(notElem '0'.show) xs


While Mike was walking in the subway, all the stuff in his back-bag dropped on the ground. There were several fax messages among them. He concatenated these strings in some order and now he has string s.  He is not sure if this is his own back-bag or someone else's. He remembered that there were exactly k messages in his own bag, each was a palindrome string and all those strings had the same length.He asked you to help him and tell him if he has worn his own back-bag. Check if the given string s is a concatenation of k palindromes of the same length.

The first line of input contains string s containing lowercase English letters (1 ≤ |s| ≤ 1000). The second line contains integer k (1 ≤ k ≤ 1000).

Print "YES"(without quotes) if he has worn his own back-bag or "NO"(without quotes) otherwise.

NotePalindrome is a string reading the same forward and backward.In the second sample, the faxes in his back-bag can be "saddas" and "tavvat".

import Control.Applicative
import Data.List

palindrome x = x== reverse x

chunks n [] = []
chunks n s = (take n s ): (chunks n (drop n s))

main= do
	s<-  getLine
	n<- read <$> getLine ::IO Int
	let les = length s
	let k = div les n
	putStrLn $ if (k*n == les) && (all palindrome ( chunks k s)) then "YES" else "NO"

main :: IO()
main = getContents >>= putStrLn . solve . lines

solve :: [String] -> String
solve [s, sk] =
    let len = length s
        k   = read sk
        m   = div len k
    in if (mod len k) == 0 && (solve' s m m "") then "YES" else "NO"
        where
            solve' :: String -> Int -> Int -> String -> Bool
            solve' "" m 0 sub = palin sub
            solve' (x:xs) m 0 sub = (palin sub) && (solve' xs m (m-1) [x])
            solve' (x:xs) m i sub = solve' xs m (i-1) (x:sub)

            palin :: String -> Bool
            palin s = s == (reverse s)

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = if (length s) `mod` k == 0 then (length s) `quot` k else 0
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes _ [] = True
checkPalindromes len str
	|
		length substr == len &&
		substr == reverse substr = checkPalindromes len newstr
	|
		otherwise = False
	where
		substr = take len str
		newstr = drop len str

{-# 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
  s <- getLine
  k <- readLn

  let
    l = length s `div` k
    ss = unfoldr (\s -> if null s then Nothing else Just $ splitAt l s) s
    check s = s == reverse s

  putStrLn $ if length s `mod` k == 0 && all check ss then "YES" else "NO"

answer::String -> Int -> String
answer s k | ((length s) `rem` k) == 0 = handan s ((length s) `div` k)
           | otherwise = "NO"
handan::String -> Int -> String
handan [] k = "YES"
handan s k | isp (take k s) = handan (drop k s) k
           | otherwise = "NO"
isp::String ->  Bool
isp s0 = s0 == reverse s0
main = do
  w <- getLine
  w0 <- getLine
  let k = read w0::Int
  putStrLn $ answer w k

import Data.List

is_pal :: String -> Bool
is_pal "" = True
is_pal (x:"") = True
is_pal cs = head cs == last cs && is_pal (init. tail $ cs)

foo :: String -> Int -> [String]
foo "" _ = []
foo cs n = (take n cs) : (foo (drop n cs) n)

main :: IO ()
main = do
  s <- getLine
  n <- return . (read::String->Int) =<< getLine
  putStrLn $ if mod (length s) n == 0 && all is_pal (foo s (length s `div` n)) then "YES" else "NO"

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

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

solve :: String -> Int -> Bool
solve s k = all palindrome (splitN (length s `div` k) s) && length s >= k && length s `mod` k == 0

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

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

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

main = do
    s <- getLine
    k <- getLine >>= return.read
    putStrLn $ if (solve s k) then "YES" else "NO"

solve :: String -> Int -> Bool
solve s k
    | (length s) `mod` k /= 0   = False
    | otherwise = sol s ((length s) `div` k)

sol [] _ = True
sol s k
    | pre == reverse pre = sol (drop k s) k
    | otherwise = False
    where pre = (take k s)

main = do
    s <- getLine
    k <- fmap read getLine
    putStrLn $ if correct s k then "YES" else "NO"

correct s k | l `mod` k /= 0 = False
            | otherwise = f s (l `div` k)
    where l = length s
          f [] _ = True
          f s' k' = let (a,b) = splitAt k' s'
                    in isPalindrome a && f b k'

isPalindrome s = s == reverse s

import Data.Bits (shift, (.&.), Bits)
import Data.List (group, sort, transpose)
import Data.Char (ord)
import Control.Applicative ((<$>))
import Control.Monad (replicateM, liftM, join, mapM_)

isPal a = foldr (&&) True $ zipWith (==) a $ reverse a

chunk _ ""  = []
chunk k str = (take k str):chunk k rest
    where rest = drop k str

pred' line k | length line `mod` k /= 0 = False
pred' line k = all isPal $ chunk (length line `div` k) line

main = do
    line <- getLine
    k <- read <$> getLine
    putStrLn $ if pred' line k then "Yes" else "No"

import Control.Applicative ((<$>))

isPal a = and $ zipWith (==) a a'
    where a' = reverse a

chunk _ ""  = []
chunk k str = (take k str):chunk k rest
    where rest = drop k str

pred' line k | length line `mod` k /= 0 = False
pred' line k = all isPal $ chunk (length line `div` k) line

main = do
    line <- getLine
    k <- read <$> getLine
    putStrLn $ if pred' line k then "Yes" else "No"

import Data.List

isPalindrome "" = False
isPalindrome s = s == reverse s

kPals 0 "" = True
kPals 0 _  = False
kPals n s  = any (\(h,t) -> isPalindrome h && (length h * (n-1)) == length t && kPals (n-1) t) (splits s)
  where splits s = zip (inits s) (tails s)

main = do
    s <- getLine
    n <- fmap read getLine
    putStr $ if kPals n s then "YES" else "NO"

import Control.Applicative
import Data.List

palindrome x = x== reverse x

chunks n [] = []
chunks n s = (take n s ): (chunks n (drop n s))

main= do
	s<-  getLine
	n<- read <$> getLine ::IO Int
	let k = div (length s ) n
	putStrLn $ if all palindrome $ chunks k s then "YES" else "NO"

-- http://codeforces.com/problemset/problem/547/A

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

slice :: Int -> [a] -> [[a]]
slice _ [] = []
slice n xs = take n xs : slice n (drop n xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		strs = slice sublen s
		palin_strs = map reverse strs

	case strs == palin_strs of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

	return ()

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

-- http://codeforces.com/problemset/problem/547/A

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

slice :: Int -> [a] -> [[a]]
slice _ [] = []
slice 0 xs = []
slice n xs = take n xs : slice n (drop n xs)

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

allEqualLen :: [[a]] -> Bool
allEqualLen [] = False
allEqualLen (x:xs) = allEqualLen' (length x) xs
	where
		allEqualLen' :: Int -> [[a]] -> Bool
		allEqualLen' _ [] = True
		allEqualLen' len (x:xs)
			| length x == len = allEqualLen' len xs
			| otherwise = False

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		strs = slice sublen s
		palin_strs = map reverse strs

	case allEqualLen strs && strs == palin_strs of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

	return ()

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

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes len str = checkPalindromes' Set.empty len str
	where
		checkPalindromes' :: Set.Set String -> Int -> String -> Bool
		checkPalindromes' _ _ [] = True
		checkPalindromes' set len str
			|
				substr `Set.notMember` set &&
				length substr == len &&
				substr == reverse substr = checkPalindromes' (Set.insert substr set) len newstr
			|
				otherwise = False
			where
				substr = take len str
				newstr = drop len str

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes _ [] = True
checkPalindromes len str
	|
		length substr == len &&
		substr == reverse substr = checkPalindromes len newstr
	|
		otherwise = False
	where
		substr = take len str
		newstr = drop len str

{-# 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
  s <- getLine
  k <- readLn

  let
    l = length s `div` k
    ss = unfoldr (\s -> if null s then Nothing else Just $ splitAt l s) s
    check s = s == reverse s

  putStrLn $ if all check ss then "YES" else "NO"

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

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

solve :: String -> Int -> Bool
solve s k = all palindrome $ splitN (length s `div` k) s

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

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

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

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))
import Data.List (unfoldr)

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

solve :: String -> Int -> Bool
solve s k = all (uncurry (&&) . ((==length s `div` k) . length &&& palindrome)) $ splitN (length s `div` k) s

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

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

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

import Data.List

isPalindrome "" = False
isPalindrome s = s == reverse s

kPals 0 _ = True
kPals n s = any (\(h,t) -> isPalindrome h && kPals (n-1) t) (splits s)
  where splits s = zip (inits s) (tails s)

main = do
    s <- getLine
    n <- fmap read getLine
    putStr $ if kPals n s then "YES" else "NO"


A positive integer is called composite if it can be represented as a product of two positive integers, both greater than $$$1$$$. For example, the following numbers are composite: $$$6$$$, $$$4$$$, $$$120$$$, $$$27$$$. The following numbers aren't: $$$1$$$, $$$2$$$, $$$3$$$, $$$17$$$, $$$97$$$.Alice is given a sequence of $$$n$$$ composite numbers $$$a_1,a_2,\ldots,a_n$$$.She wants to choose an integer $$$m \le 11$$$ and color each element one of $$$m$$$ colors from $$$1$$$ to $$$m$$$ so that:  for each color from $$$1$$$ to $$$m$$$ there is at least one element of this color;  each element is colored and colored exactly one color;  the greatest common divisor of any two elements that are colored the same color is greater than $$$1$$$, i.e. $$$\gcd(a_i, a_j)>1$$$ for each pair $$$i, j$$$ if these elements are colored the same color. Note that equal elements can be colored different colors — you just have to choose one of $$$m$$$ colors for each of the indices from $$$1$$$ to $$$n$$$.Alice showed already that if all $$$a_i \le 1000$$$ then she can always solve the task by choosing some $$$m \le 11$$$.Help Alice to find the required coloring. Note that you don't have to minimize or maximize the number of colors, you just have to find the solution with some $$$m$$$ from $$$1$$$ to $$$11$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then the descriptions of the test cases follow. The first line of the test case contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the amount of numbers in a sequence $$$a$$$. The second line of the test case contains $$$n$$$ composite integers $$$a_1,a_2,\ldots,a_n$$$ ($$$4 \le a_i \le 1000$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^4$$$.

For each test case print $$$2$$$ lines. The first line should contain a single integer $$$m$$$ ($$$1 \le m \le 11$$$) — the number of used colors. Consider colors to be numbered from $$$1$$$ to $$$m$$$. The second line should contain any coloring that satisfies the above conditions. Print $$$n$$$ integers $$$c_1, c_2, \dots, c_n$$$ ($$$1 \le c_i \le m$$$), where $$$c_i$$$ is the color of the $$$i$$$-th element. If there are multiple solutions then you can print any of them. Note that you don't have to minimize or maximize the number of colors, you just have to find the solution with some $$$m$$$ from $$$1$$$ to $$$11$$$. Remember that each color from $$$1$$$ to $$$m$$$ should be used at least once. Any two elements of the same color should not be coprime (i.e. their GCD should be greater than $$$1$$$).

NoteIn the first test case, $$$\gcd(6,10)=2$$$, $$$\gcd(6,15)=3$$$ and $$$\gcd(10,15)=5$$$. Therefore, it's valid to color all elements the same color. Note that there are other colorings which satisfy Alice's requirement in this test case.In the second test case there is only one element of each color, so the coloring definitely satisfies Alice's requirement.

import Data.Either

primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31]

main = getLine >>= test . read

test 0 = return ()
test t = do
    getLine
    as <- map read . words <$> getLine
    let sol = rights $ f 1 (Left <$> as) primes
    print $ maximum sol
    putStrLn $ unwords $ show <$> sol
    test $ pred t

f _ as [] = as
f c as (p:ps)
    | any ((== 0).(`mod` p)) $ lefts as = f (succ c) (recolor c p <$> as) ps
    | otherwise = f c as ps

recolor c p = either (\a -> if a `mod` p == 0 then Right c else Left a) Right

import Control.Monad
import Data.List
import Data.Maybe

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

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    putStrLn $ tidy $ solve xs

primes :: [(Int,Int)]
primes =zip [2,3,5,7,11,13,17,19,23,29,31] [1..]

solve :: [Int] -> [Int]
solve xs = map f xs
  where
    f x = snd $ head $ filter (\(p,_) -> x `mod` p == 0) primes

tidy :: [Int] -> String
tidy cs = (show m) ++ "\n" ++ (unwords.map show) newcs
  where
    nubbed = zip (nub cs) [(1::Int)..]
    f = fromJust . ((flip lookup) nubbed)
    newcs = map f cs
    m = length nubbed


You are given a rebus of form ? + ? - ? + ? = n, consisting of only question marks, separated by arithmetic operation '+' and '-', equality and positive integer n. The goal is to replace each question mark with some positive integer from 1 to n, such that equality holds.

The only line of the input contains a rebus. It's guaranteed that it contains no more than 100 question marks, integer n is positive and doesn't exceed 1 000 000, all letters and integers are separated by spaces, arithmetic operations are located only between question marks.

The first line of the output should contain "Possible" (without quotes) if rebus has a solution and "Impossible" (without quotes) otherwise. If the answer exists, the second line should contain any valid rebus with question marks replaced by integers from 1 to n. Follow the format given in the samples.

import Data.List
import Data.Maybe

data Equation = Equation {
    expression :: [Term]
  , equationResult :: Int
}

instance Show Equation where
  show (Equation exp n) = unwords $ (tail . concatMap showTerm $ exp) ++ ["=", show n]
    where
      showTerm (Term sign (Just value)) = [[sign], show value]
      showTerm (Term sign _) = [[sign], "?"]

type Sign = Char

data Term = Term {
    termSign :: Sign
  , termValue :: Maybe Int
}

countSign :: Sign -> [Term] -> Int
countSign sign = length . filter ((==sign) . termSign)

solve :: String -> Maybe String
solve s = let
    eq@(Equation exp n) = equationFromString s
    c1 = countSign '+' exp
    c2 = countSign '-' exp
    inRange = c1 - n * c2 <= n && n <= n * c1 - c2
    sum2 = max (c1 - n) c2
    sum1 = n + sum2
    exp' = fillExpression n sum1 sum2 c1 c2 exp
  in if inRange then Just (show (Equation exp' n)) else Nothing

fillExpression :: Int -> Int -> Int -> Int -> Int -> [Term] -> [Term]
fillExpression n sum1 sum2 c1 c2 exp = case exp of
  [] -> []
  ((Term '+' _):ts) -> Term '+' (Just x1) : fillExpression n (sum1 - x1) sum2 (c1 - 1) c2 ts
  ((Term '-' _):ts) -> Term '-' (Just x2) : fillExpression n sum1 (sum2 - x2) c1 (c2 - 1) ts
  where
    x1 = min n (sum1 - (c1 - 1))
    x2 = min n (sum2 - (c2 - 1))

equationFromString :: String -> Equation
equationFromString s = let
  (sL, (_:sR)) = splitAt (fromJust $ elemIndex '=' s) s
  signs = ('+':) . catMaybes . map f $ sL
  exp = map (flip Term Nothing) signs
  n = read sR :: Int
  f c = case c of
    '+' -> Just '+'
    '-' -> Just '-'
    _ -> Nothing
  in Equation exp n

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

-- import Debug.Trace

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-b, -a)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numMinus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

import Data.List
main = do
    s <- getLine
    let signs = filter (\c -> c == '+' || c == '-') s
        n = read . drop 1 . dropWhile (/= '=') $ s
        npos = 1 + length (elemIndices '+' signs)
        nneg = length (elemIndices '-' signs)

        cand = if nneg == 0
               then [[solve npos n, []]]
               else [[replicate npos 1, solve nneg (npos-n)],
                     [solve npos (n+nneg), replicate nneg 1]]

        res = filter (all (all (\x -> x >= 1 && x <= n))) cand
        [(p:pos), neg] = head res

        pairs = merge signs pos neg

        rest = concatMap (\(c, m) -> " " ++ [c] ++ " " ++ show m) pairs

    if null res
    then putStrLn "Impossible"
    else do
        putStrLn "Possible"
        putStrLn $ show p ++ rest ++ " = " ++ show n

merge :: String -> [Int] -> [Int] -> [(Char, Int)]
merge [] _ _ = []
merge ('+':srest) (p:prest) neg = ('+',p) : merge srest prest neg
merge ('-':srest) pos (n:nrest) = ('-',n) : merge srest pos nrest
merge _ _ _ = error "Unexpected data in merge"

solve :: Int -> Int -> [Int]
solve n sum = map (+1) $ replicate (n - s `mod` n) (s `div` n) ++ replicate (s `mod` n) ((s + n-1) `div` n)
    where s = sum - n

-- import Debug.Trace

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-b, -a)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numPlus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-a, -b)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numPlus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq


Little Alyona is celebrating Happy Birthday! Her mother has an array of n flowers. Each flower has some mood, the mood of i-th flower is ai. The mood can be positive, zero or negative.Let's define a subarray as a segment of consecutive flowers. The mother suggested some set of subarrays. Alyona wants to choose several of the subarrays suggested by her mother. After that, each of the flowers will add to the girl's happiness its mood multiplied by the number of chosen subarrays the flower is in.For example, consider the case when the mother has 5 flowers, and their moods are equal to 1,  - 2, 1, 3,  - 4. Suppose the mother suggested subarrays (1,  - 2), (3,  - 4), (1, 3), (1,  - 2, 1, 3). Then if the girl chooses the third and the fourth subarrays then:   the first flower adds 1·1 = 1 to the girl's happiness, because he is in one of chosen subarrays,  the second flower adds ( - 2)·1 =  - 2, because he is in one of chosen subarrays,  the third flower adds 1·2 = 2, because he is in two of chosen subarrays,  the fourth flower adds 3·2 = 6, because he is in two of chosen subarrays,  the fifth flower adds ( - 4)·0 = 0, because he is in no chosen subarrays. Thus, in total 1 + ( - 2) + 2 + 6 + 0 = 7 is added to the girl's happiness. Alyona wants to choose such subarrays from those suggested by the mother that the value added to her happiness would be as large as possible. Help her do this!Alyona can choose any number of the subarrays, even 0 or all suggested by her mother.

The first line contains two integers n and m (1 ≤ n, m ≤ 100) — the number of flowers and the number of subarrays suggested by the mother. The second line contains the flowers moods — n integers a1, a2, ..., an ( - 100 ≤ ai ≤ 100). The next m lines contain the description of the subarrays suggested by the mother. The i-th of these lines contain two integers li and ri (1 ≤ li ≤ ri ≤ n) denoting the subarray a[li], a[li + 1], ..., a[ri]. Each subarray can encounter more than once.

Print single integer — the maximum possible value added to the Alyona's happiness.

NoteThe first example is the situation described in the statements.In the second example Alyona should choose all subarrays.The third example has answer 0 because Alyona can choose none of the subarrays.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

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

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	[ n, m ] <- readInts
	as <- readInts
	segments <- replicateM m $ do
		lr <- readInts
		return $ mp lr
	let
		sublists = map ( $ as ) $ map sublist segments
	print $ sum $ filter ( >= 0 ) $ map sum sublists

sublist ( l, r ) = take ( r - l + 1 ) . drop ( l - 1 )

module Main (main) where

import Control.Monad
import Data.List

getm :: [Int] -> Int -> Int -> IO Int
getm nl acc _ = do
  lr <- getLine
  let l:r:_ = map read $ words lr :: [Int]
  let t = sum (drop (l-1) $ take r nl)
  return $ if t < 0
    then acc
    else acc + t

main :: IO ()
main = do
  dum <- getLine
  let n:m:_ = map read $ words dum :: [Int]
  nl <- getLine
  let an = map read $ words nl :: [Int]
  g <- foldM (getm an) 0 [1..m]
  print g

import Data.Array.Unboxed
import Control.Monad( replicateM)
main = do
    let readLine = return . map read . words =<< getLine
    [_n,_m] <- readLine
    _as <- readLine
    let readPair = do
	    [l,r] <- return . map (read::String->Int) . words =<< getLine
	    return (l,r)
    bounds <- replicateM _m readPair
    let _arr = listArray (1,_n) _as::UArray Int Int
	happineses = map f bounds
	    where f (l,r) = let v = sum $ map (_arr!) [l..r]
			    in if v>0 then v else 0
    print $ sum happineses

import Data.Array
main = interact $ show . solve . map (map read . words) . lines

solve ([n,_]:(f:ns):qs) = sum $ map (max 0 . query) qs
  where sa = array (1, n) $ (1,f) : [(i, v + (sa ! (i - 1))) | (i,v) <- [2..] `zip` ns]
        query [l, r] = (sa ! r) - sum [sa ! (l-1) | l > 1]


Nikolay has only recently started in competitive programming, but already qualified to the finals of one prestigious olympiad. There going to be $$$n$$$ participants, one of whom is Nikolay. Like any good olympiad, it consists of two rounds. Tired of the traditional rules, in which the participant who solved the largest number of problems wins, the organizers came up with different rules.Suppose in the first round participant A took $$$x$$$-th place and in the second round — $$$y$$$-th place. Then the total score of the participant A is sum $$$x + y$$$. The overall place of the participant A is the number of participants (including A) having their total score less than or equal to the total score of A. Note, that some participants may end up having a common overall place. It is also important to note, that in both the first and the second round there were no two participants tying at a common place. In other words, for every $$$i$$$ from $$$1$$$ to $$$n$$$ exactly one participant took $$$i$$$-th place in first round and exactly one participant took $$$i$$$-th place in second round.Right after the end of the Olympiad, Nikolay was informed that he got $$$x$$$-th place in first round and $$$y$$$-th place in the second round. Nikolay doesn't know the results of other participants, yet he wonders what is the minimum and maximum place he can take, if we consider the most favorable and unfavorable outcome for him. Please help Nikolay to find the answer to this question.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases to solve. Each of the following $$$t$$$ lines contains integers $$$n$$$, $$$x$$$, $$$y$$$ ($$$1 \leq n \leq 10^9$$$, $$$1 \le x, y \le n$$$) — the number of participants in the olympiad, the place that Nikolay took in the first round and the place that Nikolay took in the second round.

Print two integers — the minimum and maximum possible overall place Nikolay could take.

NoteExplanation for the first example:Suppose there were 5 participants A-E. Let's denote Nikolay as A. The the most favorable results for Nikolay could look as follows:  However, the results of the Olympiad could also look like this:  In the first case Nikolay would have taken first place, and in the second — third place.

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  [n,x,y] <- (map read.words) <$> getLine
  putStr $ show (solve2 n x y)
  putStr " "
  putStrLn $ show (solve1 n x y)

solve1 :: Int -> Int -> Int -> Int
solve1 n x y = v
  where
    s = x+y
    v = min n (s-1)

solve2 :: Int -> Int -> Int -> Int
solve2 n x y =min n (n-( v-1))
  where
    s =2*n -(x+y) +2 -1
    v = min n (s-1)

import Control.Monad
main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  [n,x,y] <- (map read.words) <$> getLine
  putStr $ show (solve2 n x y)
  putStr " "
  putStrLn $ show (solve1 n x y)

solve1 :: Int -> Int -> Int -> Int
solve1 n x y = v
  where
    s = x+y
    v = min n (s-1)

solve2 :: Int -> Int -> Int -> Int
solve2 n x y =n-( v-1)
  where
    s =2*n -(x+y) +2 -1
    v = min n (s-1)