There are $$$n$$$ monsters standing in a row numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th monster has $$$h_i$$$ health points (hp). You have your attack power equal to $$$a$$$ hp and your opponent has his attack power equal to $$$b$$$ hp.You and your opponent are fighting these monsters. Firstly, you and your opponent go to the first monster and fight it till his death, then you and your opponent go the second monster and fight it till his death, and so on. A monster is considered dead if its hp is less than or equal to $$$0$$$.The fight with a monster happens in turns.   You hit the monster by $$$a$$$ hp. If it is dead after your hit, you gain one point and you both proceed to the next monster.  Your opponent hits the monster by $$$b$$$ hp. If it is dead after his hit, nobody gains a point and you both proceed to the next monster. You have some secret technique to force your opponent to skip his turn. You can use this technique at most $$$k$$$ times in total (for example, if there are two monsters and $$$k=4$$$, then you can use the technique $$$2$$$ times on the first monster and $$$1$$$ time on the second monster, but not $$$2$$$ times on the first monster and $$$3$$$ times on the second monster).Your task is to determine the maximum number of points you can gain if you use the secret technique optimally.

The first line of the input contains four integers $$$n, a, b$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5, 1 \le a, b, k \le 10^9$$$) — the number of monsters, your attack power, the opponent's attack power and the number of times you can use the secret technique. The second line of the input contains $$$n$$$ integers $$$h_1, h_2, \dots, h_n$$$ ($$$1 \le h_i \le 10^9$$$), where $$$h_i$$$ is the health points of the $$$i$$$-th monster.

Print one integer — the maximum number of points you can gain if you use the secret technique optimally.

import Control.Monad
import Data.List (sort)

espNes:: Int -> Int -> Int -> Int
espNes hp a b = let
    suma = a + b
    resto = mod hp suma
    in if (resto<=a && resto>0) then 0 else (if (resto>a) then (if ((mod (resto-a) a)==0) then div (resto-a) a else (div (resto-a) a)+1) else (if((mod b a)==0) then div b a else (div b a)+1))

listaMons:: [String] -> Int -> Int -> [Int]
listaMons [x] a b = [espNes (read x ::Int) a b]
listaMons (x:xs) a b = (espNes (read x ::Int) a b) : (listaMons xs a b)

final:: [Int] -> Int ->Int -> Int
final [] k puntos = puntos
final lista k puntos = if (k-(head lista)>=0 || (head lista)==0) then final (tail lista) (k-(head lista)) (puntos+1) else puntos

output:: Int -> IO ()
output out = print out

strToInt:: String -> Int
strToInt pal = read pal ::Int

main::IO()
main = do
    inp <- getLine
    let inpList = map strToInt (words inp)
    mons <- getLine
    let a = (head (tail inpList))
    let b = (head (tail (tail inpList)))
    let k = (last (inpList))
    let lisMons = sort (listaMons (words mons) a b)
    let fin = final lisMons k 0
    output (fin)


Ehab loves number theory, but for some reason he hates the number $$$x$$$. Given an array $$$a$$$, find the length of its longest subarray such that the sum of its elements isn't divisible by $$$x$$$, or determine that such subarray doesn't exist.An array $$$a$$$ is a subarray of an array $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

The first line contains an integer $$$t$$$ $$$(1 \le t \le 5)$$$ — the number of test cases you need to solve. The description of the test cases follows. The first line of each test case contains 2 integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 10^5$$$, $$$1 \le x \le 10^4$$$) — the number of elements in the array $$$a$$$ and the number that Ehab hates. The second line contains $$$n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_{n}$$$ ($$$0 \le a_i \le 10^4$$$) — the elements of the array $$$a$$$.

For each testcase, print the length of the longest subarray whose sum isn't divisible by $$$x$$$. If there's no such subarray, print $$$-1$$$.

NoteIn the first test case, the subarray $$$[2,3]$$$ has sum of elements $$$5$$$, which isn't divisible by $$$3$$$.In the second test case, the sum of elements of the whole array is $$$6$$$, which isn't divisible by $$$4$$$.In the third test case, all subarrays have an even sum, so the answer is $$$-1$$$.

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

routine :: IO ()
routine = do
    [a, b] <- (map read.words) <$> getLine
    l <- (map read.words) <$> getLine
    putStrLn $ show (solve l b)

solve :: [Int] -> Int -> Int
solve l m = getAns ([0] ++ (map (\x->mod x m) (scanl1 (+) l)))

getAns :: [Int] -> Int
getAns modarray =
    if isEmpty modarray then -1
    else
    if (head modarray /= last modarray) then length modarray - 1
        else
            maxi x y
            where
                x = fmap (\x->length modarray-x-1) (findFirst modarray)
                y = findLast modarray

maxi :: (Maybe Int) -> (Maybe Int) -> Int
maxi Nothing Nothing = 1
maxi Nothing (Just a) = a
maxi (Just b) Nothing = b
maxi (Just a) (Just b) = (max a b)

isEmpty :: [Int] -> Bool
isEmpty [] = True
isEmpty (a:b) = if a == 0 then (isEmpty b) else False

-- first index that's not equal to the first element
findFirst :: [Int] -> Maybe Int
findFirst l = fmap (+1) (findIndex (/= (head l)) (tail l))

findLast :: [Int] -> Maybe Int
findLast l = fmap (\x->(length l)-1-x) (findFirst (reverse l))


You are given positive integer number n. You should create such strictly increasing sequence of k positive numbers a1, a2, ..., ak, that their sum is equal to n and greatest common divisor is maximal.Greatest common divisor of sequence is maximum of such numbers that every element of sequence is divisible by them.If there is no possible sequence then output -1.

The first line consists of two numbers n and k (1 ≤ n, k ≤ 1010).

If the answer exists then output k numbers — resulting sequence. Otherwise output -1. If there are multiple answers, print any of them.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List

main = do
  [n, k] <- fmap readInts B.getLine
  B.putStr $ B.unwords $ map (B.pack . show) $ solve n k

solve n k
  | s > n = [-1]
  | otherwise = (\g -> let s' = n `div` g in map (*g) $ [1,2..k-1] ++ [s' - k * (k - 1) `div` 2]) $ maybe undefined id $ find (\i -> n `rem` i == 0) $ reverse $ takeWhile (<= n `div` s) $ divs n
  where s = k  * (k + 1) `div` 2 :: Integer

divs x = sort $ concatMap (\i -> [i, x `div` i]) $ filter (\i -> x `rem` i == 0) [1..1 + floor (sqrt $ fromIntegral x)]

readInt = maybe undefined (fromIntegral . fst) . B.readInteger
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (ByteString, getLine)
import qualified Data.ByteString.Char8 as C (readInteger, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (intercalate)

readInt :: B.ByteString -> I.Int64
readInt = fromIntegral . fst . M.fromJust . C.readInteger

run n sk 0 = -1
run n sk i | n `mod` i == 0 && n `div` i >= sk = i | otherwise = run n sk (i - 1)

runx n sk i | i > mnx = -1 where mnx = min n 100000
runx n sk i | r == 0 && n `mod` d == 0 && n `div` d >= sk = d
            | otherwise = runx n sk (i + 1) where
    (d, r) = n `divMod` i

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    let sk = (1 + k) * k `div` 2
        gh = max (runx n sk 1) (run n sk (min n 100000))
        gi = map (gh *) ([1..k - 1] ++ [n `div` gh - sk + k])
    putStrLn $ if k > 200000 || gh == -1 then "-1" else (L.intercalate " " . (map show)) gi

import Control.Monad
import Control.Applicative
import Text.Printf

solve :: Integer -> Integer -> [Integer]
solve n k
 | kk2 > n = [-1]
 | otherwise = map ((*) a) [1..k-1] ++ [ee]
        where kk2 = k*(k+1)`div`2
              lim = n`div`kk2
              a = run 1 0
              run i acc
               | i > lim = acc
               | i*i > n = acc
               | n`mod`i == 0 = let other = n`div` i
                                    in run (i+1) (max i (if (other <= lim) then max other acc else acc))
               | otherwise = run (i+1) acc
              ee = n - (k*(k-1))`div`2*a

main :: IO ()
main = do
        (n:k:_) <- map read . words <$> getLine
        forM_ (solve n k) $ \i -> do
            printf "%d " i
        printf "\n"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (ByteString, getLine)
import qualified Data.ByteString.Char8 as C (readInteger, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (intercalate)

readInt :: B.ByteString -> I.Int64
readInt = fromIntegral . fst . M.fromJust . C.readInteger

run n sk 0 = -1
run n sk i | n `mod` i == 0 && n `div` i >= sk = i | otherwise = run n sk (i - 1)

runx n sk i | i > min (n - 1) 100000 = -1
runx n sk i | n `mod` i == 0 && n `mod` (n `div` i) == 0 && n `div` (n `div` i) >= sk = n `div` i | otherwise = runx n sk (i + 1)

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    let sk = (1 + k) * k `div` 2
        gr = runx n sk 1
        gh = if gr /= -1 then gr else run n sk (min (n - 1) 100000)
        gi = map (gh *) ([1..k - 1] ++ [n `div` gh - sk + k])
    putStrLn $ if gh == -1 then "-1" else (L.intercalate " " . (map show)) gi

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (ByteString, getLine)
import qualified Data.ByteString.Char8 as C (readInteger, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (intercalate)

readInt :: B.ByteString -> I.Int64
readInt = fromIntegral . fst . M.fromJust . C.readInteger

run n sk 0 = -1
run n sk i | n `mod` i == 0 && n `div` i >= sk = i | i == n = -1 | otherwise = run n sk (i - 1)

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    let sk = (1 + k) * k `div` 2
        gr = run n sk n
        gh = if gr /= -1 then gr else run n sk (min (n - 1) 100000)
        gi = map (gh *) ([1..k - 1] ++ [n `div` gh - sk + k])
    putStrLn $ if gh == -1 then "-1" else (L.intercalate " " . (map show)) gi


Bob recently read about bitwise operations used in computers: AND, OR and XOR. He have studied their properties and invented a new game.Initially, Bob chooses integer m, bit depth of the game, which means that all numbers in the game will consist of m bits. Then he asks Peter to choose some m-bit number. After that, Bob computes the values of n variables. Each variable is assigned either a constant m-bit number or result of bitwise operation. Operands of the operation may be either variables defined before, or the number, chosen by Peter. After that, Peter's score equals to the sum of all variable values.Bob wants to know, what number Peter needs to choose to get the minimum possible score, and what number he needs to choose to get the maximum possible score. In both cases, if there are several ways to get the same score, find the minimum number, which he can choose.

The first line contains two integers n and m, the number of variables and bit depth, respectively (1 ≤ n ≤ 5000; 1 ≤ m ≤ 1000).  The following n lines contain descriptions of the variables. Each line describes exactly one variable. Description has the following format: name of a new variable, space, sign ":=", space, followed by one of:   Binary number of exactly m bits.  The first operand, space, bitwise operation ("AND", "OR" or "XOR"), space, the second operand. Each operand is either the name of variable defined before or symbol '?', indicating the number chosen by Peter.  Variable names are strings consisting of lowercase Latin letters with length at most 10. All variable names are different.

In the first line output the minimum number that should be chosen by Peter, to make the sum of all variable values minimum possible, in the second line output the minimum number that should be chosen by Peter, to make the sum of all variable values maximum possible. Both numbers should be printed as m-bit binary numbers.

5 1
a := 1
bb := 0
cx := ? OR a
d := ? XOR ?
e := d AND bb

NoteIn the first sample if Peter chooses a number 0112, then a = 1012, b = 0112, c = 0002, the sum of their values is 8. If he chooses the number 1002, then a = 1012, b = 0112, c = 1112, the sum of their values is 15.For the second test, the minimum and maximum sum of variables a, bb, cx, d and e is 2, and this sum doesn't depend on the number chosen by Peter, so the minimum Peter can choose is 0.

import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (replicate m '1') a b
        h0 = take m $ h (replicate m '0') a b

h _ _ [] = repeat 0
h t a ((var, x, op, y):b) =
  zipWith (+) k l
  where j "?" = t
        j x = a ! x
        k = zipWith (i op) (j x) (j y)
        k' = fmap (\x -> if x == 0 then '0' else '1') k
        l = h t (insert var k' a) b

i "AND" '1' '1' = 1 :: Int
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1

import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (insert "?" (repeat '1') a) b
        h0 = take m $ h (insert "?" (repeat '0') a) b

h _ [] = repeat 0
h a ((var, x, op, y):b) =
  zipWith (+) k s
  where k = zipWith (i op) (a ! x) (a ! y)
        l = fmap (\x -> if x == 0 then '0' else '1') k
        s = h (insert var l a) b

i "AND" '1' '1' = 1
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1

import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (insert "?" (repeat '1') a) b
        h0 = take m $ h (insert "?" (repeat '0') a) b

h _ [] = repeat 0
h a ((var, x, op, y):b) =
  zipWith (+) k s
  where k = zipWith (i op) x y
        l = fmap (\x -> if x == 0 then '0' else '1') k
        s = h (insert var l a) b

i "AND" '1' '1' = 1
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1


William has array of $$$n$$$ numbers $$$a_1, a_2, \dots, a_n$$$. He can perform the following sequence of operations any number of times:   Pick any two items from array $$$a_i$$$ and $$$a_j$$$, where $$$a_i$$$ must be a multiple of $$$2$$$  $$$a_i = \frac{a_i}{2}$$$  $$$a_j = a_j \cdot 2$$$ Help William find the maximal sum of array elements, which he can get by performing the sequence of operations described above.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(1 \le n \le 15)$$$, the number of elements in William's array. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i < 16)$$$, the contents of William's array.

For each test case output the maximal sum of array elements after performing an optimal sequence of operations.

NoteIn the first example test case the optimal sequence would be:   Pick $$$i = 2$$$ and $$$j = 1$$$. After performing a sequence of operations $$$a_2 = \frac{4}{2} = 2$$$ and $$$a_1 = 6 \cdot 2 = 12$$$, making the array look as: [12, 2, 2].  Pick $$$i = 2$$$ and $$$j = 1$$$. After performing a sequence of operations $$$a_2 = \frac{2}{2} = 1$$$ and $$$a_1 = 12 \cdot 2 = 24$$$, making the array look as: [24, 1, 2].  Pick $$$i = 3$$$ and $$$j = 1$$$. After performing a sequence of operations $$$a_3 = \frac{2}{2} = 1$$$ and $$$a_1 = 24 \cdot 2 = 48$$$, making the array look as: [48, 1, 1]. The final answer $$$48 + 1 + 1 = 50$$$.In the third example test case there is no way to change the sum of elements, so the answer is $$$10$$$.

main=interact$unlines.map(show.(\(a,b)->sum b+(maximum b)*(2^(sum a)-1)).unzip.map(until(odd.snd)(\(a,b)->(a+1,div b 2)).(,)0)).map(map read.words).t.tail.lines
t(_:x:s)=x:t s
t _=[]

import Control.Arrow ((***))

main :: IO ()
main = interact $ unlines . map (show . findMaxSumCanGetFromArray) . parseTests

findMaxSumCanGetFromArray :: [Integer] -> Integer
findMaxSumCanGetFromArray array = result
    where
        (new_array, twos_powers) = unzip $ map takeAwayTwoAsFactor array
        result = sum new_array + (maximum new_array) * (2 ^ (sum twos_powers) - 1)

takeAwayTwoAsFactor :: Integer -> (Integer, Integer)
takeAwayTwoAsFactor x = until (odd . fst) ((`div` 2) *** (+1)) (x, 0)

parseTests :: String -> [[Integer]]
parseTests = map (map read . words) . takeEverySecond . drop 1 . lines

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

import Control.Arrow ((***))

main :: IO ()
main = interact $ unlines . map (show . findMaxSumCanGetFromArray) . parseTests

findMaxSumCanGetFromArray :: [Integer] -> Integer
findMaxSumCanGetFromArray array = result
    where
        (new_array, twos_powers) = unzip $ map takeAwayTwoAsFactor array
        result = sum new_array + (maximum new_array) * (2 ^ (sum twos_powers) - 1)

takeAwayTwoAsFactor :: Integer -> (Integer, Integer)
takeAwayTwoAsFactor x
    | even x = (id *** (+1)) $ takeAwayTwoAsFactor (x `div` 2)
    | otherwise = (x, 0)

parseTests :: String -> [[Integer]]
parseTests = map (map read . words) . takeEverySecond . drop 1 . lines

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

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

recurse k ys [] = (k,ys)
recurse k ys (x:xs)
  | even x = recurse (k+1) ys (x`div`2 : xs)
  | odd x = recurse k (x:ys) xs

solve :: IO ()
solve = do
  ~[n] <- readv
  xs <- readv
  let
    (k,ys) = recurse 0 [] xs
    s = sum ys
    m = DL.maximum ys
    ans = s - m + (2^k)*m
  printv [ans]

printv :: [Integer] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat $  map (\x->DBB.integerDec x <> DBB.char8 ' ') xs

readv :: IO [Integer]
readv = map (maybe 0 fst . DBC.readInteger) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ (fromIntegral nTc) solve

import Control.Monad

-- pointfree style go brrrrrr

power :: Integer -> (Integer, Integer)
power = until ((/=) 0 . flip mod 2 . fst) ((,) <$> (`div` 2) . fst <*> (* 2) . snd) . ((,) <$> id <*> const 1)

solve :: [Integer] -> Integer
solve = (((. (*)) . (.) . (+) <$> ((-) <$> sum <*> maximum) <*> maximum) <$> (<$>) fst <*> product . (<$>) snd) . (<$>) power

test :: IO ()
test = getLine >> getLine >>= print . solve . (<$>) read . words

main :: IO ()
main = readLn >>= flip replicateM_ test

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

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

oe :: Int -> (Int, Int)
oe = go 0  where
  go acc x = acc `seq` if  odd x
    then  (x, acc)
    else  go (acc + 1) (quot x 2)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      (odds, p2s) = unzip $ map oe a
      lv : svs = sortOn negate odds
    pure $ putInts [foldl' (\acc x -> acc * 2 ^ x) lv p2s + sum svs]

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

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

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

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


Mike is the president of country What-The-Fatherland. There are n bears living in this country besides Mike. All of them are standing in a line and they are numbered from 1 to n from left to right. i-th bear is exactly ai feet high.   A group of bears is a non-empty contiguous segment of the line. The size of a group is the number of bears in that group. The strength of a group is the minimum height of the bear in that group.Mike is a curious to know for each x such that 1 ≤ x ≤ n the maximum strength among all groups of size x.

The first line of input contains integer n (1 ≤ n ≤ 2 × 105), the number of bears. The second line contains n integers separated by space, a1, a2, ..., an (1 ≤ ai ≤ 109), heights of bears.

Print n integers in one line. For each x from 1 to n, print the maximum strength among all groups of size x.

-- Codeforces 547B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST.Safe
import           Data.Array.Unboxed
import           Data.Array.ST.Safe
import qualified Data.ByteString.Char8 as BC
import           Data.Foldable
import           Data.Maybe
import           Data.STRef

-- For each i, find the largest j that aj < ai and show it by li (if there is no such j, then li = 0).
-- Also, find the smallest j that aj < ai and show it by ri (if there is no such j, then ri = n + 1).
-- This can be done in O(n) with a stack.

-- For each i, we know that ai can be minimum element in groups of size 1, 2, ..., ri - li - 1.

-- reference solution (by PrinceOfPersia): http://ideone.com/Ryg2gn

main :: IO ()
main = do
    n <- fmap read getLine
    BC.getContents >>= BC.putStrLn . BC.intercalate " " . map (BC.pack . show) . solve n . map (fst . fromJust . BC.readInt) . BC.words

popgreater :: Int -> STRef s Int -> STUArray s Int Int -> STUArray s Int Int -> ST s (Maybe Int)
popgreater k top stk xs = do
    vtop <- readSTRef top
    if vtop > 0
       then do
          idx <- readArray stk (vtop - 1)
          x <- readArray xs idx
          if x >= k
             then do
                writeSTRef top (vtop - 1)
                popgreater k top stk xs
             else return (Just idx)
       else return Nothing

pushback :: Int -> STRef s Int -> STUArray s Int Int -> ST s ()
pushback k top stk = do
    vtop <- readSTRef top
    writeArray stk vtop k
    writeSTRef top (vtop + 1)

solve :: Int -> [Int] -> [Int]
solve n xs = elems $ runSTUArray $ do
    xsarr <- newListArray (0, n - 1) xs :: ST s (STUArray s Int Int)
    ls <- newArray (0, n - 1) (-1) :: ST s (STUArray s Int Int)
    rs <- newArray (0, n - 1) n :: ST s (STUArray s Int Int)
    stk <- newArray_ (0, n - 1) :: ST s (STUArray s Int Int)

    top <- newSTRef 0 -- initialize stack.
    for_ [0 .. n-1] $ \i -> do
        v <- readArray xsarr i
        x <- popgreater v top stk xsarr
        case x of
            Nothing -> return ()
            Just idx -> writeArray ls i idx
        pushback i top stk

    writeSTRef top 0 -- clear stack.
    for_ [n-1, n-2 .. 0] $ \i -> do
        v <- readArray xsarr i
        x <- popgreater v top stk xsarr
        case x of
            Nothing -> return ()
            Just idx -> writeArray rs i idx
        pushback i top stk

    ans <- newArray (1, n) 0 :: ST s (STUArray s Int Int)

    for_ [0 .. n-1] $ \i -> do
        l <- readArray ls i
        r <- readArray rs i
        let k = r - l - 1
        x <- readArray ans k
        v <- readArray xsarr i
        writeArray ans k (max x v)

    for_ [n-1, n-2 .. 1] $ \i -> do
        a <- readArray ans i
        b <- readArray ans (i + 1)
        writeArray ans i (max a b)

    return ans


You are given a grid with $$$n$$$ rows and $$$m$$$ columns. We denote the square on the $$$i$$$-th ($$$1\le i\le n$$$) row and $$$j$$$-th ($$$1\le j\le m$$$) column by $$$(i, j)$$$ and the number there by $$$a_{ij}$$$. All numbers are equal to $$$1$$$ or to $$$-1$$$. You start from the square $$$(1, 1)$$$ and can move one square down or one square to the right at a time. In the end, you want to end up at the square $$$(n, m)$$$.Is it possible to move in such a way so that the sum of the values written in all the visited cells (including $$$a_{11}$$$ and $$$a_{nm}$$$) is $$$0$$$?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 10^4$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1000$$$)  — the size of the grid. Each of the following $$$n$$$ lines contains $$$m$$$ integers. The $$$j$$$-th integer on the $$$i$$$-th line is $$$a_{ij}$$$ ($$$a_{ij} = 1$$$ or $$$-1$$$)  — the element in the cell $$$(i, j)$$$. It is guaranteed that the sum of $$$n\cdot m$$$ over all test cases does not exceed $$$10^6$$$.

For each test case, print "YES" if there exists a path from the top left to the bottom right that adds up to $$$0$$$, and "NO" otherwise. You can output each letter in any case.

NoteOne possible path for the fourth test case is given in the picture in the statement.

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B

step :: (Int -> Int -> Int) -> Int -> [Int] -> [Int] -> [Int]
step op e dp xs = tail $ scanl' (\v (w,x) -> x + op v w) e (zip dp xs)

inf = 10^9 :: Int

solve :: [[Int]] -> Bool
solve arr = even vmin && vmin <= 0 && vmax >= 0
  where
    m = length arr
    n = length $ arr !! 0
    vmin = last $ foldl' (step min inf) (0 : repeat inf) arr
    vmax = last $ foldl' (step max (-inf)) (0 : repeat (-inf)) arr

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

main :: IO ()
main = do
  [tc] <- readInts
  replicateM_ tc $ do
    [m,n] <- readInts
    arr <- replicateM m readInts
    putStrLn $ if solve arr then "YES" else "NO"

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Data.List

step :: (Int -> Int -> Int) -> Int -> [Int] -> [Int] -> [Int]
step op e dp xs = tail $ scanl' (\v (w,x) -> x + op v w) e (zip dp xs)

inf = 10^9 :: Int

solve :: [[Int]] -> Bool
solve arr = even (m*n) && vmin <= 0 && vmax >= 0
  where
    m = length arr
    n = length $ arr !! 0
    vmin = last $ foldl' (step min inf) (0 : repeat inf) arr
    vmax = last $ foldl' (step max (-inf)) (0 : repeat (-inf)) arr

main :: IO ()
main = do
  tc <- readLn
  replicateM_ tc $ do
    [m,n] <- map read . words <$> getLine
    arr <- replicateM m $ map read . words <$> getLine
    putStrLn $ if solve arr then "YES" else "NO"


Sasha and Kolya decided to get drunk with Coke, again. This time they have k types of Coke. i-th type is characterised by its carbon dioxide concentration . Today, on the party in honour of Sergiy of Vancouver they decided to prepare a glass of Coke with carbon dioxide concentration . The drink should also be tasty, so the glass can contain only integer number of liters of each Coke type (some types can be not presented in the glass). Also, they want to minimize the total volume of Coke in the glass.Carbon dioxide concentration is defined as the volume of carbone dioxide in the Coke divided by the total volume of Coke. When you mix two Cokes, the volume of carbon dioxide sums up, and the total volume of Coke sums up as well.Help them, find the minimal natural number of liters needed to create a glass with carbon dioxide concentration . Assume that the friends have unlimited amount of each Coke type.

The first line contains two integers n, k (0 ≤ n ≤ 1000, 1 ≤ k ≤ 106) — carbon dioxide concentration the friends want and the number of Coke types. The second line contains k integers a1, a2, ..., ak (0 ≤ ai ≤ 1000) — carbon dioxide concentration of each type of Coke. Some Coke types can have same concentration.

Print the minimal natural number of liter needed to prepare a glass with carbon dioxide concentration , or -1 if it is impossible.

NoteIn the first sample case, we can achieve concentration  using one liter of Coke of types  and : .In the second case, we can achieve concentration  using two liters of  type and one liter of  type: .

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs (x + y) <= 1000 ]

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let iter (x, i, ac) = let x' = S.difference (dmap x xs) ac in (x', i + 1, S.union x' ac)
        (S.size -> l, ans, _) = until (\(a, _, _) -> S.size a == 0 || S.member 0 a) iter (xs, 1, xs)
    putStrLn $ show $ if l == 0 then -1 else ans

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member,
    findMin, findMax, map, singleton, null, intersection)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (fn, fx) (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs (x + y) <= max (abs fx) (abs fn) ]

iter nx xs (x, i, ac) | S.member 0 x'                                    = (S.singleton 0, i + 1,       ac)
                      | not (S.null (S.intersection (S.map (0-) x') x))  = (S.singleton 0, 2 * i + 1,   ac)
                      | not (S.null (S.intersection (S.map (0-) x') x')) = (S.singleton 0, 2 * (i + 1), ac)
                      | otherwise = (x', i + 1, S.union x' ac) where
    x' = S.difference (dmap nx x xs) ac

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let nx = (S.findMin xs, S.findMax xs)
        end (a, _, _) = S.size a == 0 || S.member 0 a
        (_, ans, _) = until end (iter nx xs) (xs, 1, xs)
    putStrLn $ show $ if fst nx * snd nx > 0 then -1 else ans

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member,
    findMin, findMax, map, singleton, null, intersection)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (fn, fx) (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs x + y <= max (abs fx) (abs fn) ]

iter nx xs (x, i, ac) | S.member 0 x'                             = (S.singleton 0, i + 1,       ac)
                      | not (S.null (S.intersection (S.map (0-) x') x))  = (S.singleton 0, 2 * i + 1,   ac)
                      | not (S.null (S.intersection (S.map (0-) x') x')) = (S.singleton 0, 2 * (i + 1), ac)
                      | otherwise = (x', i + 1, S.union x' ac) where
    x' = S.difference (dmap nx x xs) ac

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let nx = (S.findMin xs, S.findMax xs)
        end (a, _, _) = S.size a == 0 || S.member 0 a
        (_, ans, _) = until end (iter nx xs) (xs, 1, xs)
    putStrLn $ show $ if fst nx * snd nx > 0 then -1 else ans


Constanze is the smartest girl in her village but she has bad eyesight.One day, she was able to invent an incredible machine! When you pronounce letters, the machine will inscribe them onto a piece of paper. For example, if you pronounce 'c', 'o', 'd', and 'e' in that order, then the machine will inscribe "code" onto the paper. Thanks to this machine, she can finally write messages without using her glasses.However, her dumb friend Akko decided to play a prank on her. Akko tinkered with the machine so that if you pronounce 'w', it will inscribe "uu" instead of "w", and if you pronounce 'm', it will inscribe "nn" instead of "m"! Since Constanze had bad eyesight, she was not able to realize what Akko did.The rest of the letters behave the same as before: if you pronounce any letter besides 'w' and 'm', the machine will just inscribe it onto a piece of paper.The next day, I received a letter in my mailbox. I can't understand it so I think it's either just some gibberish from Akko, or Constanze made it using her machine. But since I know what Akko did, I can just list down all possible strings that Constanze's machine would have turned into the message I got and see if anything makes sense.But I need to know how much paper I will need, and that's why I'm asking you for help. Tell me the number of strings that Constanze's machine would've turned into the message I got.But since this number can be quite large, tell me instead its remainder when divided by $$$10^9+7$$$.If there are no strings that Constanze's machine would've turned into the message I got, then print $$$0$$$.

Input consists of a single line containing a string $$$s$$$ ($$$1 \leq |s| \leq 10^5$$$) — the received message. $$$s$$$ contains only lowercase Latin letters.

Print a single integer — the number of strings that Constanze's machine would've turned into the message $$$s$$$, modulo $$$10^9+7$$$.

NoteFor the first example, the candidate strings are the following: "ouuokarinn", "ouuokarim", "owokarim", and "owokarinn".For the second example, there is only one: "banana".For the third example, the candidate strings are the following: "nm", "mn" and "nnn".For the last example, there are no candidate strings that the machine can turn into "amanda", since the machine won't inscribe 'm'.

import Data.List

main = interact $ unlines . map (show . f) . lines

mdl f a b = f a b `mod` 1000000007

fb = 1:1:zipWith (mdl (+)) fb (tail fb)

f s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (mdl (*))
    $ map ((!!) fb . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import Data.List

main = interact $ show . f

mdl f a b = f a b `mod` 1000000007

fb = 1:1:zipWith (mdl (+)) fb (tail fb)

f s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else foldl1 (mdl (*))
  $ map ((!!) fb . length)
  $ groupBy (\a b -> a `elem` "un" && a == b) s

import           Data.List

count x = length . filter (== x)

main = interact
  $ unlines
  . map (show . solve)
  . lines

modulo = 1000000007

fibs = 1:1:zipWith (\a b -> (a + b) `mod` modulo) fibs (tail fibs)

solve s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (\a b -> (a * b) `mod` modulo)
    $ map ((!!) fibs . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import Data.List
import Data.Int

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c = md . product . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

fib = fst . fib2

-- | Return (fib n, fib (n + 1))
fib2 0 = (1, 1)
fib2 1 = (1, 2)
fib2 n
 | even n    = (a*a + b*b, c*c - a*a)
 | otherwise = (c*c - a*a, b*b + c*c)
 where (a,b) = fib2 (n `div` 2 - 1)
       c     = a + b

md :: Integer -> Int
md x = fromInteger $ x `mod` 1000000007

import           Data.List

count x = length . filter (== x)

main = interact
  $ unlines
  . map (show . solve)
  . lines

modulo = 1000000007

fibs = 1:1:zipWith (\a b -> (a + b) `mod` modulo) fibs (tail fibs)

solve :: String -> Int
solve s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (\a b -> (a * b) `mod` modulo)
    $ map ((!!) fibs . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import Data.List

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' ((md.) . (*)) 1 l

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007

import Data.List
import Data.Int

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' (mmul) 1 l

-- mul as i64, overflow otherwise
mmul :: Int -> Int -> Int
mmul a b = md $ fromIntegral (toI64 a * toI64 b)
  where toI64 = fromIntegral :: Int -> Int64

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007

import Data.List

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . (+1) . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' ((md.) . (*)) 1 l

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007


Polycarp has a string $$$s$$$. Polycarp performs the following actions until the string $$$s$$$ is empty ($$$t$$$ is initially an empty string):  he adds to the right to the string $$$t$$$ the string $$$s$$$, i.e. he does $$$t = t + s$$$, where $$$t + s$$$ is a concatenation of the strings $$$t$$$ and $$$s$$$;  he selects an arbitrary letter of $$$s$$$ and removes from $$$s$$$ all its occurrences (the selected letter must occur in the string $$$s$$$ at the moment of performing this action). Polycarp performs this sequence of actions strictly in this order.Note that after Polycarp finishes the actions, the string $$$s$$$ will be empty and the string $$$t$$$ will be equal to some value (that is undefined and depends on the order of removing).E.g. consider $$$s$$$="abacaba" so the actions may be performed as follows:  $$$t$$$="abacaba", the letter 'b' is selected, then $$$s$$$="aacaa";  $$$t$$$="abacabaaacaa", the letter 'a' is selected, then $$$s$$$="c";  $$$t$$$="abacabaaacaac", the letter 'c' is selected, then $$$s$$$="" (the empty string). You need to restore the initial value of the string $$$s$$$ using only the final value of $$$t$$$ and find the order of removing letters from $$$s$$$.

The first line contains one integer $$$T$$$ ($$$1 \le T \le 10^4$$$) — the number of test cases. Then $$$T$$$ test cases follow. Each test case contains one string $$$t$$$ consisting of lowercase letters of the Latin alphabet. The length of $$$t$$$ doesn't exceed $$$5 \cdot 10^5$$$. The sum of lengths of all strings $$$t$$$ in the test cases doesn't exceed $$$5 \cdot 10^5$$$.

For each test case output in a separate line:   $$$-1$$$, if the answer doesn't exist;  two strings separated by spaces. The first one must contain a possible initial value of $$$s$$$. The second one must contain a sequence of letters — it's in what order one needs to remove letters from $$$s$$$ to make the string $$$t$$$. E.g. if the string "bac" is outputted, then, first, all occurrences of the letter 'b' were deleted, then all occurrences of 'a', and then, finally, all occurrences of 'c'. If there are multiple solutions, print any one.

7
abacabaaacaac
nowyouknowthat
polycarppoycarppoyarppyarppyrpprppp
isi
everywherevrywhrvryhrvrhrvhv
haaha
qweqeewew

abacaba bac
-1
polycarp lcoayrp
is si
everywhere ewyrhv
-1
-1

NoteThe first test case is considered in the statement.

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let s = C.takeWhile isLetter line -- codeforces compatibility
    let ans = calc s
    if (length ans) == 0 then
      print (-1)
    else
      C.putStrLn $ C.unwords ans

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = tail (lines input)
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest final_string = case restoreInitialStringAndDeletionOrder final_string of
    Just (restored_string, deletion_order) -> restored_string ++ " " ++ deletion_order
    Nothing -> "-1"

restoreInitialStringAndDeletionOrder :: String -> Maybe (String, String)
restoreInitialStringAndDeletionOrder final_string = result
    where
        deletion_order = restoreDeletionOrder final_string
        initial_string = restoreInitialString final_string deletion_order
        final_string_will_get = computeFinalString initial_string deletion_order
        can_restore = final_string == final_string_will_get
        result = if can_restore then Just (initial_string, deletion_order) else Nothing

computeFinalString :: String -> String -> String
computeFinalString initial_string [] = []
computeFinalString initial_string (char_to_delete:next_deletions) =
    initial_string ++ computeFinalString next_string next_deletions
    where next_string = filter (/= char_to_delete) initial_string

restoreInitialString :: String -> String -> String
restoreInitialString final_string deletion_order = take initial_string_size final_string
    where
        initial_string_size =
            sum [countElement char final_string `div` lifetime | (char, lifetime) <- zip deletion_order [1..]]

restoreDeletionOrder :: String -> String
restoreDeletionOrder = reverse . takeFirstOccurrences . reverse

takeFirstOccurrences :: Eq a => [a] -> [a]
takeFirstOccurrences [] = []
takeFirstOccurrences (x:xs) = x : takeFirstOccurrences (filter (/= x) xs)

countElement :: Eq a => a -> [a] -> Int
countElement char string = length (filter (== char) string)

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    putStr "'"
    C.putStr line
    putStr "'"
    putStr $ show $ ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    putStr $ show $ ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    C.putStr $ check line suffix 0 ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    let first = C.take 7 line
    let second = applyRule C.empty first suffix
    if second == (C.pack "abacabaaacaac") then
      C.putStrLn $ C.unwords [second, C.pack suffix]
    else
      putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    let first = C.take 7 line
    let second = applyRule C.empty first suffix
    C.putStrLn $ C.unwords [second, C.pack suffix]
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    --let suffix = findSuffix line
    --print suffix
    --let first = take 7 line
    --print $ applyRule [] first suffix
    let ans = calc line
    if (length ans) == 0 then
      print (-1)
    else
      C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.IntSet as S

findSuffix' :: String -> S.IntSet -> String -> String
findSuffix' [] _ acc = acc
findSuffix' (x:xs) tree acc =
  if S.member (ord x) tree then
    findSuffix' xs tree acc
  else
    findSuffix' xs (S.insert (ord x) tree) (x:acc)

findSuffix :: String -> String
findSuffix s = findSuffix' (reverse s) S.empty []

applyRule :: String -> String -> String -> String
applyRule t [] _ = t
applyRule t s (x:xs) =
  let newS = filter (/= x) s
  in
    applyRule (t ++ s) newS xs

check :: String -> String -> Int -> Int -> String
check _ _ l r | l >= r = []
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = take (m+1) s
      t = applyRule [] left suffix
  in
    if t == s then
      left
    else if (length t) < (length s) then
      check s suffix (m+1) r
    else
      check s suffix l m

calc :: String -> [String]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((length s) - 1)
  in
    if null ans then []
    else [ans, suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    --let suffix = findSuffix line
    --print suffix
    --let first = take 7 line
    --print $ applyRule [] first suffix
    let ans = calc line
    if (length ans) == 0 then
      print (-1)
    else
      putStrLn $ unwords ans


Hacker Zhorik wants to decipher two secret messages he intercepted yesterday. Yeah message is a sequence of encrypted blocks, each of them consists of several bytes of information.Zhorik knows that each of the messages is an archive containing one or more files. Zhorik knows how each of these archives was transferred through the network: if an archive consists of k files of sizes l1, l2, ..., lk bytes, then the i-th file is split to one or more blocks bi, 1, bi, 2, ..., bi, mi (here the total length of the blocks bi, 1 + bi, 2 + ... + bi, mi is equal to the length of the file li), and after that all blocks are transferred through the network, maintaining the order of files in the archive.Zhorik thinks that the two messages contain the same archive, because their total lengths are equal. However, each file can be split in blocks in different ways in the two messages.You are given the lengths of blocks in each of the two messages. Help Zhorik to determine what is the maximum number of files could be in the archive, if the Zhorik's assumption is correct.

The first line contains two integers n, m (1 ≤ n, m ≤ 105) — the number of blocks in the first and in the second messages. The second line contains n integers x1, x2, ..., xn (1 ≤ xi ≤ 106) — the length of the blocks that form the first message. The third line contains m integers y1, y2, ..., ym (1 ≤ yi ≤ 106) — the length of the blocks that form the second message. It is guaranteed that x1 + ... + xn = y1 + ... + ym. Also, it is guaranteed that x1 + ... + xn ≤ 106.

Print the maximum number of files the intercepted array could consist of.

NoteIn the first example the maximum number of files in the archive is 3. For example, it is possible that in the archive are three files of sizes 2 + 5 = 7, 15 = 3 + 1 + 11 = 8 + 2 + 4 + 1 and 4 + 4 = 8.In the second example it is possible that the archive contains two files of sizes 1 and 110 = 10 + 100 = 100 + 10. Note that the order of files is kept while transferring archives through the network, so we can't say that there are three files of sizes 1, 10 and 100.In the third example the only possibility is that the archive contains a single file of size 4.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

run n p q [] [] | p == q = if p == 0 then n else n + 1
run n p q (x:xs) (y:ys) | p == q = run (n + 1) x y xs ys
run n p q (x:xs) ys | p < q = run n (p + x) q xs ys
run n p q xs (y:ys) | p > q = run n p (q + y) xs ys

main = do
    B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    (map readInt . C.words -> ys) <- B.getLine
    putStrLn $ show $ run (-1) 0 0 xs ys


Little Artyom decided to study probability theory. He found a book with a lot of nice exercises and now wants you to help him with one of them.Consider two dices. When thrown each dice shows some integer from 1 to n inclusive. For each dice the probability of each outcome is given (of course, their sum is 1), and different dices may have different probability distributions.We throw both dices simultaneously and then calculate values max(a, b) and min(a, b), where a is equal to the outcome of the first dice, while b is equal to the outcome of the second dice. You don't know the probability distributions for particular values on each dice, but you know the probability distributions for max(a, b) and min(a, b). That is, for each x from 1 to n you know the probability that max(a, b) would be equal to x and the probability that min(a, b) would be equal to x. Find any valid probability distribution for values on the dices. It's guaranteed that the input data is consistent, that is, at least one solution exists.

First line contains the integer n (1 ≤ n ≤ 100 000) — the number of different values for both dices. Second line contains an array consisting of n real values with up to 8 digits after the decimal point  — probability distribution for max(a, b), the i-th of these values equals to the probability that max(a, b) = i. It's guaranteed that the sum of these values for one dice is 1. The third line contains the description of the distribution min(a, b) in the same format.

Output two descriptions of the probability distribution for a on the first line and for b on the second line.  The answer will be considered correct if each value of max(a, b) and min(a, b) probability distribution values does not differ by more than 10 - 6 from ones given in input. Also, probabilities should be non-negative and their sums should differ from 1 by no more than 10 - 6.

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""

{-# LANGUAGE ForeignFunctionInterface, MultiWayIf, OverloadedStrings #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Foreign.C.String
import Foreign.C.Types
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

foreign import ccall "stdio.h printf" c_printf :: CString -> Double -> IO ()
foreign import ccall "stdio.h putchar" c_putchar :: Int -> IO ()

writeDouble x = withCString "%.9f" $ flip c_printf x

writeChar :: Char -> IO ()
writeChar = c_putchar . fromEnum

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'
  forM_ ys ((>> writeChar ' ') . writeDouble)
  writeChar '\n'

{-# LANGUAGE ForeignFunctionInterface, MultiWayIf, OverloadedStrings #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Foreign.C.String
import Foreign.C.Types
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

foreign import ccall "stdio.h printf" c_printf :: CString -> Double -> IO ()
foreign import ccall "stdio.h putchar" c_putchar :: Int -> IO ()

writeDouble x = withCString "%.9f" $ flip c_printf x

writeChar :: Char -> IO ()
writeChar = c_putchar . fromEnum

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""


You are given three integers $$$n, a, b$$$. Determine if there exists a permutation $$$p_1, p_2, \ldots, p_n$$$ of integers from $$$1$$$ to $$$n$$$, such that:There are exactly $$$a$$$ integers $$$i$$$ with $$$2 \le i \le n-1$$$ such that $$$p_{i-1} < p_i > p_{i+1}$$$ (in other words, there are exactly $$$a$$$ local maximums).There are exactly $$$b$$$ integers $$$i$$$ with $$$2 \le i \le n-1$$$ such that $$$p_{i-1} > p_i < p_{i+1}$$$ (in other words, there are exactly $$$b$$$ local minimums).If such permutations exist, find any such permutation.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The description of test cases follows. The only line of each test case contains three integers $$$n$$$, $$$a$$$ and $$$b$$$ ($$$2 \leq n \leq 10^5$$$, $$$0 \leq a,b \leq n$$$). The sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, if there is no permutation with the requested properties, output $$$-1$$$. Otherwise, print the permutation that you are found. If there are several such permutations, you may print any of them.

NoteIn the first test case, one example of such permutations is $$$[1, 3, 2, 4]$$$. In it $$$p_1 < p_2 > p_3$$$, and $$$2$$$ is the only such index, and $$$p_2> p_3 < p_4$$$, and $$$3$$$ the only such index.One can show that there is no such permutation for the third test case.

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

import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.Array.IO
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

glue :: [Int] -> [Int] -> [Int]
glue (x1:xs) (y1:ys) = x1:y1:glue xs ys
glue xs [] = xs
glue [] ys = ys

process :: Int -> Int -> [Int] -> Maybe [Int]
process 0 0 xs@(x1:x2:_)
    | x1 < x2 = Just $ reverse $ sort xs
    | x1 > x2 = Just $ sort xs
process 0 0 xs = Just xs
process a b (x1:x2:xs)
    | a > 0 && x1 > x2 = (x1:) <$> process (a-1) b (x2:xs)
    | b > 0 && x1 < x2 = (x1:) <$> process a (b-1) (x2:xs)
process _ _ _ = Nothing

main = do
    [t] <- readInts
    replicateM_ t $ do
        [n, a, b] <- readInts
        let firstmax = take n $ glue [1,2..] [n,n-1..]
            firstmin = take n $ glue [n,n-1..] [1,2..]
            go (x:xs) = (x:) <$> process a b xs
        case go firstmax <|> go firstmin of
            Nothing -> print (-1)
            Just ans -> printList ans

printList :: Show a => [a] -> IO ()
printList = putStrLn . unwords . map show

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

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f


Polycarp found on the street an array $$$a$$$ of $$$n$$$ elements.Polycarp invented his criterion for the beauty of an array. He calls an array $$$a$$$ beautiful if at least one of the following conditions must be met for each different pair of indices $$$i \ne j$$$:   $$$a_i$$$ is divisible by $$$a_j$$$;  or $$$a_j$$$ is divisible by $$$a_i$$$. For example, if:   $$$n=5$$$ and $$$a=[7, 9, 3, 14, 63]$$$, then the $$$a$$$ array is not beautiful (for $$$i=4$$$ and $$$j=2$$$, none of the conditions above is met);  $$$n=3$$$ and $$$a=[2, 14, 42]$$$, then the $$$a$$$ array is beautiful;  $$$n=4$$$ and $$$a=[45, 9, 3, 18]$$$, then the $$$a$$$ array is not beautiful (for $$$i=1$$$ and $$$j=4$$$ none of the conditions above is met); Ugly arrays upset Polycarp, so he wants to remove some elements from the array $$$a$$$ so that it becomes beautiful. Help Polycarp determine the smallest number of elements to remove to make the array $$$a$$$ beautiful.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ numbers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$) — elements of the array $$$a$$$.

For each test case output one integer — the minimum number of elements that must be removed to make the array $$$a$$$ beautiful.

NoteIn the first test case, removing $$$7$$$ and $$$14$$$ will make array $$$a$$$ beautiful.In the second test case, the array $$$a$$$ is already beautiful.In the third test case, removing one of the elements $$$45$$$ or $$$18$$$ will make the array $$$a$$$ beautiful.In the fourth test case, the array $$$a$$$ is beautiful.

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

max_ai :: Int
max_ai = 2 * 10^(5 :: Int)

newSTUArray :: (Int, Int) -> Int -> ST s (STUArray s Int Int)
newSTUArray = newArray

solve :: [Int] -> Int
solve a = let
  cts :: UArray Int Int
  cts = accumArray (+) 0 (1, max_ai) $ zip a (repeat 1)
  ansArr = runSTUArray $ do
    w <- newSTUArray (1, max_ai) 0
    forM_ [1..max_ai] $ \i ->
      forM_ [1 .. div max_ai i] $ \j -> do
        prev <- if  j > 1
          then  readArray w i
          else  pure 0
        let  k = i * j
        old <- readArray w k
        writeArray w k $ max old (prev + cts ! k)
    pure w
  in  maximum $ elems ansArr

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    a <- readInts
    outLine . P.pack . show $ n - solve a


You are playing a game similar to Sokoban on an infinite number line. The game is discrete, so you only consider integer positions on the line.You start on a position $$$0$$$. There are $$$n$$$ boxes, the $$$i$$$-th box is on a position $$$a_i$$$. All positions of the boxes are distinct. There are also $$$m$$$ special positions, the $$$j$$$-th position is $$$b_j$$$. All the special positions are also distinct.In one move you can go one position to the left or to the right. If there is a box in the direction of your move, then you push the box to the next position in that direction. If the next position is taken by another box, then that box is also pushed to the next position, and so on. You can't go through the boxes. You can't pull the boxes towards you.You are allowed to perform any number of moves (possibly, zero). Your goal is to place as many boxes on special positions as possible. Note that some boxes can be initially placed on special positions.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. Then descriptions of $$$t$$$ testcases follow. The first line of each testcase contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the number of boxes and the number of special positions, respectively. The second line of each testcase contains $$$n$$$ distinct integers in the increasing order $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_1 < a_2 < \dots < a_n \le 10^9$$$; $$$a_i \neq 0$$$) — the initial positions of the boxes. The third line of each testcase contains $$$m$$$ distinct integers in the increasing order $$$b_1, b_2, \dots, b_m$$$ ($$$-10^9 \le b_1 < b_2 < \dots < b_m \le 10^9$$$; $$$b_i \neq 0$$$) — the special positions. The sum of $$$n$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$. The sum of $$$m$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase print a single integer — the maximum number of boxes that can be placed on special positions.

NoteIn the first testcase you can go $$$5$$$ to the right: the box on position $$$1$$$ gets pushed to position $$$6$$$ and the box on position $$$5$$$ gets pushed to position $$$7$$$. Then you can go $$$6$$$ to the left to end up on position $$$-1$$$ and push a box to $$$-2$$$. At the end, the boxes are on positions $$$[-2, 6, 7, 11, 15]$$$, respectively. Among them positions $$$[-2, 6, 7, 15]$$$ are special, thus, the answer is $$$4$$$.In the second testcase you can push the box from $$$-1$$$ to $$$-10^9$$$, then the box from $$$1$$$ to $$$10^9$$$ and obtain the answer $$$2$$$.The third testcase showcases that you are not allowed to pull the boxes, thus, you can't bring them closer to special positions.In the fourth testcase all the boxes are already on special positions, so you can do nothing and still obtain the answer $$$3$$$.In the fifth testcase there are fewer special positions than boxes. You can move either $$$8$$$ or $$$9$$$ to the right to have some box on position $$$10$$$.

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

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

countLessEqual :: Array Int Int -> Int -> Int -> Int -> Int
countLessEqual a l r x
  | l == r = l
  | a ! m <= x = countLessEqual a m r x
  | otherwise = countLessEqual a l (m - 1) x
  where
  m = (l + r) `quot` 2 + 1

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve as bs' = func bs 0 0
  where
  bs = dropWhile (< head as) bs'
  n = length as
  a = listArray (0, n - 1) as
  func [] _ opt = opt
  func (y : ys) i opt
    | i < n - 1 && a ! (i + 1) <= y + i + 1 = func (y : ys) (i + 1) opt
    | otherwise = func ys i $ max opt $ count y (y + i)
  count y1 y2 = countLessEqual b 0 bn y2 - countLessEqual b 0 bn (y1 - 1) + dn - countLessEqual d 0 dn y2
  bn = length bs
  b = listArray (0, bn) (0 : bs)
  f [] _ = []
  f _ [] = []
  f (x : xs) (y : ys)
    | x < y = f xs (y : ys)
    | x > y = f (x : xs) ys
    | otherwise = x : f xs ys
  ds = f as bs
  dn = length ds
  d = listArray (0, dn) (0 : ds)

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, m] <- getInts
    as <- getInts
    bs <- getInts
    let
      (a1, a2) = partition (<0) as
      (b1, b2) = partition (<0) bs
      f = reverse . map negate
      result = solve (f a1) (f b1) + solve a2 b2
    C.putStrLn $ C.pack $ show result

{-# LANGUAGE ViewPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

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

import Data.Array.Unboxed

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch fun li ri = if  li == ri
  then  li
  else  let
  mi = li + div (ri - li) 2
  in  if  fun mi
  then  binSearch fun li mi
  else  binSearch fun (mi+1) ri

solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve aLi bLi = let
  n = length aLi
  m = length bLi
  a = listArray (1, n) aLi :: UArray Int Int
  b = listArray (1, m) bLi :: UArray Int Int
  boxesBefore pos = binSearch (\ix -> a ! ix > pos) 1 (n+1) - 1
  kthSpace k = binSearch (\pos -> pos - boxesBefore pos >= k) 1 (n + k)
  boxesAt pos = let
    ix = boxesBefore pos
    in  if  ix > 0 && a ! ix == pos  then  1  else  0
  preCovered :: UArray Int Int
  preCovered = listArray (1, m+1) $ scanr (+) 0 $ map boxesAt $ elems b
  score ix = let
    secondGap = kthSpace $ b ! ix
    gapIx = binSearch (\jx -> b ! jx >= secondGap) 1 (m+1)
    in  gapIx - ix + preCovered ! gapIx
  in  foldl' max minBound $ map score [1..m]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, _m] <- readInts
    aLi <- readInts
    bLi <- readInts
    let
      (reverse . map negate -> negAli, posAli) = span (< 0) aLi
      (reverse . map negate -> negBli, posBli) = span (< 0) bLi
    putInts [solve negAli negBli + solve posAli posBli]

type SIO = StateT P.ByteString IO

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

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

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


David was given a red checkered rectangle of size $$$n \times m$$$. But he doesn't like it. So David cuts the original or any other rectangle piece obtained during the cutting into two new pieces along the grid lines. He can do this operation as many times as he wants.As a result, he will get a set of rectangles. Rectangles $$$1 \times 1$$$ are forbidden.David also knows how to paint the cells blue. He wants each rectangle from the resulting set of pieces to be colored such that any pair of adjacent cells by side (from the same piece) have different colors.What is the minimum number of cells David will have to paint?

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases. The next lines contain descriptions of test cases. The only line of each test case contains two integers $$$n$$$, $$$m$$$ ($$$1 \leq n, m \leq 3 \cdot 10^4$$$, $$$n \cdot m \geq 2$$$).

For each test case print a single integer — the minimum number of cells David will have to paint blue.

NoteThe following pictures show how the initial rectangle can be split and cells colored blue.In the first test case:  In the second test case:  In the third test case:  In the fourth test case:

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [size_y, size_x] = map read $ words input
        result = findMinBlueCellsN (size_x, size_y)
        output = show result

findMinBlueCellsN :: (Integer, Integer) -> Integer
findMinBlueCellsN (size_x, size_y)
    | not (size_y <= size_x) = findMinBlueCellsN (size_y, size_x)
    | size_x < 2 || size_y < 1 = 0
    | size_x `mod` 3 == 0 || size_y `mod` 3 == 0 = size_x * size_y `div` 3
    | size_y == 1 = size_x `div` 3 + 1
    | otherwise = minimum [findMinBlueCellsN (size_x - 1, size_y) + findMinBlueCellsN (1, size_y),
                           findMinBlueCellsN (size_x, size_y - 1) + findMinBlueCellsN (size_x, 1)]

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [size_y, size_x] = map read $ words input
        result = findMinBlueCellsN (size_x, size_y)
        output = show result

findMinBlueCellsN :: (Integer, Integer) -> Integer
findMinBlueCellsN (size_x, size_y)
    | not (size_y <= size_x) = findMinBlueCellsN (size_y, size_x)
    | size_x < 2 || size_y < 1 = 0
    | size_y < 2 = size_x `div` 3 + (if size_x `mod` 3 == 0 then 0 else 1)
    | size_x `mod` 3 == 0 || size_y `mod` 3 == 0 = size_x * size_y `div` 3
    | otherwise = minimum [findMinBlueCellsN (size_x - 1, size_y) + findMinBlueCellsN (1, size_y),
                           findMinBlueCellsN (size_x, size_y - 1) + findMinBlueCellsN (size_x, 1)]

import qualified Control.Monad as CM

solve :: IO ()
solve = do
  ~[x,y] <- readv
  printv [(x*y+2)`div`3]

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [n, m] = (n * m + 2) `div` 3


The Berland State University is hosting a ballroom dance in celebration of its 100500-th anniversary! n boys and m girls are already busy rehearsing waltz, minuet, polonaise and quadrille moves.We know that several boy&girl pairs are going to be invited to the ball. However, the partners' dancing skill in each pair must differ by at most one.For each boy, we know his dancing skills. Similarly, for each girl we know her dancing skills. Write a code that can determine the largest possible number of pairs that can be formed from n boys and m girls.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of boys. The second line contains sequence a1, a2, ..., an (1 ≤ ai ≤ 100), where ai is the i-th boy's dancing skill. Similarly, the third line contains an integer m (1 ≤ m ≤ 100) — the number of girls. The fourth line contains sequence b1, b2, ..., bm (1 ≤ bj ≤ 100), where bj is the j-th girl's dancing skill.

Print a single number — the required maximum possible number of pairs.

import           Control.Applicative
import           Control.Monad
import           Data.List
import qualified Data.Map            as Map
import qualified Data.Set            as Set

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve (b:bs) (g:gs)
  | abs (b - g) <= 1 = 1 + solve bs gs
  | b < g = solve bs (g:gs)
  | otherwise = solve (b:bs) gs

main = do
  _ <- getLine
  b <- sort . (map read) . words <$> getLine
  _ <- getLine
  g <- sort . (map read) . words <$> getLine
  print $ solve b g

import Data.List

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

solve :: [Int] -> Int
solve (n:s) =
    let a = take n s
        b = drop (n + 1) s
    in  solve' (sort a) (sort b)
    where
        solve' :: [Int] -> [Int] -> Int
        solve' [] _ = 0
        solve' _ [] = 0
        solve' (a:ax) (b:bx) | abs (a - b) <= 1 = 1 + (solve' ax bx)
                             | a < b            = solve' ax (b:bx)
                             | otherwise        = solve' (a:ax) bx

-- reading the tutorials is how to get better!!!
-- read a ton of the tutorials!!!!
import Data.List

pairthem one two pairs
  | (null one) || (null two) = pairs
  | ((head one) - (head two)) < (-1) = pairthem (tail one) two pairs
  | ((head one) - (head two)) > 1 = pairthem one (tail two) pairs
  | ((head one) - (head two)) <= 1 && ((head two) - (head one)) >= -1 =
      pairthem (tail one) (tail two) (pairs+1)

conv lst uu
  | (null lst) = uu
  | otherwise = conv (tail lst) (((read (head lst))::Int) : uu)

main = do
  ff <- getLine
  gg <- getLine
  ss <- getLine
  zz <- getLine

  let aa = conv (words gg) []
      bb = conv (words zz) []

      cc = sort aa
      dd = sort bb

  let    ans = pairthem cc dd 0
  putStrLn (show ans)

import Data.List

main = interact $ show.g.pick.f.lines
f xs = map (\x -> (map read (words x)) :: [Integer]) xs
pick (a:b:c:d:[]) = [(sort b), (sort d)]
g (x:y:[]) = merge x y 0
merge [] ys ans = ans
merge xs [] ans = ans
merge (x:xs) (y:ys) ans
  | abs (x - y) <= 1 = merge xs ys (ans + 1)
  | x < y = merge xs (y:ys) ans
  | otherwise = merge (x:xs) ys ans

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

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

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

main = do
  n <- readLn
  xs ::UArray Int Int <- listArray (1, n) . sort <$> getInts
  m <- readLn
  ys :: UArray Int Int <- listArray (1, m) . sort <$> getInts

  let
    r = listArray ((0, 0), (n, m)) $ map (uncurry f) [(i, j) | i <- [0..n], j <- [0..m]] :: Array (Int, Int) Int
      where
        f 0 _ = 0
        f _ 0 = 0

        f i j
          | abs (xs!i - ys!j) <= 1 = max (1 + r!(i-1, j-1)) (max (r!(i-1, j)) (r!(i, j-1)))
          | otherwise = max (r!(i-1, j)) (r!(i, j-1))

  print $ r!(n, m)

module Main where

import Control.Applicative
import Control.Monad
import Data.List           (sort)
import System.IO

toNum :: Num a => Bool -> a
toNum False = 0
toNum True  = 1

solve :: Integral t => [t] -> [t] -> t
solve boys_skills girls_skills = process (sort boys_skills) (sort girls_skills)
  where
    process (x:xs) (y:ys)
        | x - y > 1 = process (x : xs) ys
        | x - y < -1 = process xs (y : ys)
        | otherwise = 1 + process xs ys
    process _ _ = 0

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering Nothing
    hSetBuffering stdout $ BlockBuffering Nothing
    getLine
    boys_skills <- map read . words <$> getLine
    getLine
    girls_skills <- map read . words <$> getLine
    print $ solve boys_skills girls_skills

import Data.List
import Data.Maybe
import Data.Char
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.map ( map read. words). (\[a,b,c,d]->[b,d]) . take 4. lines
solve :: [[Integer]]->String
solve [xs,ys] =  show $ slv1 (sort xs) (sort ys)
slv1 [] (y:ys) =0
slv1 (x:xs) [] =0
slv1 [] []     =0
slv1 (x:xs) (y:ys) | x-y>1    = slv1 (x:xs) (ys)
                   | y-x>1    = slv1 (xs) (y:ys)
                   |otherwise = 1+slv1 xs ys

import Control.Applicative
import Data.List

solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve [] _ = 0
solve (x:xs) (y:ys)
    | abs (x - y) < 2 = 1 + solve xs ys
    | x < y = solve xs (y:ys)
    | otherwise = solve (x:xs) ys

main = do
    getLine
    bs <- sort.(fmap read).words <$> getLine
    getLine
    gs <- sort.(fmap read).words <$> getLine
    print $ solve bs gs

-- Codeforces 489B

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine
    ns <- fmap (map read . words) getLine
    m <- fmap read getLine
    ms <- fmap (map read . words) getLine
    print $ solve n m (sort ns) (sort ms)

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve n m ns ms = snd $ foldl (\(mss, acc) b -> case (findIndex (\a -> (-1 <= b-a) && (1 >= b-a)) mss)
    of {
        Nothing -> (mss, acc);
        Just k -> (drop (k+1) mss, acc+1) ;
    }) (ms, 0) ns

import Control.Applicative
import Data.List

process [] _ n = n
process _ [] n = n
process (q1:q1s) (q2:q2s) n | abs (q1-q2) <=1 = process q1s q2s (n+1)
                            | q1 <q2 = process q1s (q2:q2s) n
                            | otherwise  = process (q1:q1s) q2s n

main = do
  n1<- read <$> getLine ::IO Int
  q1<-   sort <$> map read  <$>   words  <$> getLine ::IO [Int]
  n2<- read <$> getLine ::IO Int
  q2<-   sort <$> map read  <$>   words  <$> getLine ::IO [Int]
  print $ process q1 q2 0

import Data.List

f :: [Int] -> [Int] -> Int
f [] x = 0
f x [] = 0
f (b:bs) (g:gs)
    | b<g       = if (b==g-1) then 1 + f bs gs else f bs (g:gs)
    | otherwise = if (b-g<=1) then 1 + f bs gs else f (b:bs) gs

main = do
    getLine
    b <- getLine
    getLine
    g <- getLine
    putStrLn $ show $ f (sort (map read (words b))) (sort (map read (words g)))

import Data.List (sort)

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

solve :: [[Integer]] -> Integer
solve [_, as, _, bs] = go (sort as) (sort bs)
  where go xxs@(x:xs) yys@(y:ys) | x + 1 < y = go xs yys
                                 | y + 1 < x = go xxs ys
                                 | otherwise = 1 + go xs ys
        go _ _ = 0
solve _ = undefined

import Data.List (sort)
main = interact $ show . length . uncurry merge . parse
parse = go . map read . words where
  go (n:xs) = (sort bs,sort gs)
    where (bs,(_:gs)) = splitAt n xs
merge as@(a:as') bs@(b:bs')
  | abs (a-b) <= 1 = a : merge as' bs'
  | a < b = merge as' bs
  | a > b = merge as bs'
merge _ _ = []

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.List

-- Meat

solve :: [Int] -> [Int] -> Int
solve as bs = answer (sort as) (sort bs)

answer :: [Int] -> [Int] -> Int
answer [] _ = 0
answer _ [] = 0
answer (b:bs) (g:gs)
    | abs (b - g) <= 1 = 1 + answer bs gs
    | b < g = answer bs (g:gs)
    | b > g = answer (b:bs) gs

answer _ _ = error "Sucker"
-- Shit
main :: IO ()
main = do
        [_, bs, _, gs] <- readShit
        printShit [solve bs gs]

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

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

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

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

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

count [] _ n = n
count _ [] n = n
count (a:as) (b:bs) n | abs (a-b) <=1 = count as bs (n+1)
                      | a<b = count as (b:bs) n
                      | otherwise = count (a:as) bs n

main= do
		getLine
 		a<- sort.map read. words <$> getLine::IO [Int]
		getLine
 		b<- sort.map read. words <$> getLine::IO [Int]
	        print $ count a b 0

import Data.List (sort)

process :: [Int] -> [Int] -> Int
process as bs = f (sort as) (sort bs)
    where
        f [] _ = 0
        f _ [] = 0
        f as@(a:as') bs@(b:bs')
            | abs (a-b) <= 1 = 1 + f as' bs'
            | a < b = f as' bs
            | otherwise = f as bs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    m <- fmap readInt getLine
    bs <- fmap (map readInt.words) getLine
    print $ process as bs

import qualified Data.List as List

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve ax@(x : xs) ay@(y : ys)
    | abs (x - y) <= 1 = 1 + solve xs ys
    | x < y = solve xs ay
    | x > y = solve ax ys

main = do
    getLine
    boy <- getLine
    getLine
    girl <- getLine
    let a = List.sort $ map read $ words boy
        b = List.sort $ map read $ words girl
    print $ solve a b

import Data.List

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

parseInput input = [sort xs, sort ys] where
    ls = lines input
    xs = map read $ words $ ls !! 1 :: [Int]
    ys = map read $ words $ ls !! 3 :: [Int]

main = do
    input <- getContents
    let [xs, ys] = parseInput input
    print $ solve xs ys

module Main where

import Control.Applicative
import Control.Monad
import Data.List           (foldl', sort)
import System.IO

toNum :: Num a => Bool -> a
toNum False = 0
toNum True  = 1

solve :: Integral t => [t] -> [t] -> t
solve boys_skills girls_skills = process (sort boys_skills) (sort girls_skills)
  where
    process xs ys = foldl' (\acc (x, y) -> acc + is_matching x y) 0 $ zip xs ys
    is_matching x y = toNum $ abs (x - y) <= 1

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering Nothing
    hSetBuffering stdout $ BlockBuffering Nothing
    getLine
    boys_skills <- map read . words <$> getLine
    getLine
    girls_skills <- map read . words <$> getLine
    print $ solve boys_skills girls_skills

-- Codeforces 489B

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine
    ns <- fmap (map read . words) getLine
    m <- fmap read getLine
    ms <- fmap (map read . words) getLine
    print $ solve n m ns ms

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve n m ns ms = snd $ foldl (\(mss, acc) b -> case (findIndex (\a -> (-1 <= b-a) && (1 >= b-a)) mss)
    of {
        Nothing -> ([], acc);
        Just k -> (drop (k+1) mss, acc+1) ;
    }) (ms, 0) ns