The company "Divan's Sofas" is planning to build $$$n + 1$$$ different buildings on a coordinate line so that:   the coordinate of each building is an integer number;  no two buildings stand at the same point. Let $$$x_i$$$ be the coordinate of the $$$i$$$-th building. To get from the building $$$i$$$ to the building $$$j$$$, Divan spends $$$|x_i - x_j|$$$ minutes, where $$$|y|$$$ is the absolute value of $$$y$$$.All buildings that Divan is going to build can be numbered from $$$0$$$ to $$$n$$$. The businessman will live in the building $$$0$$$, the new headquarters of "Divan's Sofas". In the first ten years after construction Divan will visit the $$$i$$$-th building $$$a_i$$$ times, each time spending $$$2 \cdot |x_0-x_i|$$$ minutes for walking.Divan asks you to choose the coordinates for all $$$n + 1$$$ buildings so that over the next ten years the businessman will spend as little time for walking as possible.

Each test contains several test cases. The first line contains one integer number $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of test cases. The first line of each case contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of buildings that "Divan's Sofas" is going to build, apart from the headquarters. The second line contains the sequence $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^6$$$), where $$$a_i$$$ is the number of visits to the $$$i$$$-th building. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, on the first line print the number $$$T$$$ — the minimum time Divan will spend walking.  On the second line print the sequence $$$x_0, x_1, \ldots, x_n$$$ of $$$n + 1$$$ integers, where $$$x_i$$$ ($$$-10^6 \le x_i \le 10^6$$$) is the selected coordinate of the $$$i$$$-th building. It can be shown that an optimal answer exists with coordinates not exceeding $$$10^6$$$. If there are multiple answers, print any of them.

NoteLet's look at the first example.Divan will visit the first building $$$a_1 = 1$$$ times, the second $$$a_2 = 2$$$ times and the third $$$a_3 = 3$$$ times. Then one of the optimal solution will be as follows:   the headquarters is located in $$$x_0 = 2$$$;  $$$x_1 = 4$$$: Divan will spend $$$2 \cdot |x_0-x_1| \cdot a_1 = 2 \cdot |2-4| \cdot 1 = 4$$$ minutes walking to the first building;  $$$x_2 = 1$$$: Divan will spend $$$2 \cdot |x_0-x_2| \cdot a_2 = 2 \cdot |2-1| \cdot 2 = 4$$$ minutes walking to the second building;  $$$x_3 = 3$$$: Divan will spend $$$2 \cdot |x_0-x_3| \cdot a_3 = 2 \cdot |2-3| \cdot 3 = 6$$$ minutes walking to the third building. In total, Divan will spend $$$4 + 4 + 6 = 14$$$ minutes. It can be shown that it is impossible to arrange buildings so that the businessman spends less time.Among others, $$$x = [1, 3, 2, 0]$$$, $$$x = [-5, -3, -6, -4]$$$ are also correct answers for the first example.

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

solve :: IO ()
solve = do
  ~[n] <- readv
  xs <- readv
  let valpos = DL.sortOn ((*(-1)).fst) $ zip xs [1..]
      ans = recurse [] [] (-1) 1 valpos
      (vals,poss) = unzip ans
      cost = 2 * sum vals
      perm = map snd (DL.sortOn fst $ zip poss [1..])
  print cost
  printv perm

recurse neg pos _ _ [] = neg ++ [(0,0)] ++ (reverse pos)
recurse neg pos this other ((v,p):valpos)
  | (this>0) = recurse neg ((v*this,p):pos) other (this+1) valpos
  | otherwise = recurse ((-v*this,p):neg) pos other (this-1) valpos

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

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

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

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

solve :: IO ()
solve = do
  ~[n] <- readv
  xs <- readv
  let valpos = DL.sortOn ((*(-1)).fst) $ zip xs [1..]
      ans = recurse [] [] (-1) 1 valpos
      (vals,poss) = unzip ans
      cost = 2 * sum vals
      perm = map snd (DL.sortOn fst $ zip poss [1..])
  print cost
  printv poss

recurse neg pos _ _ [] = neg ++ [(0,0)] ++ (reverse pos)
recurse neg pos this other ((v,p):valpos)
  | (this>0) = recurse neg ((v*this,p):pos) other (this+1) valpos
  | otherwise = recurse ((-v*this,p):neg) pos other (this-1) valpos

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

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

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

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

solve :: IO ()
solve = do
  ~[n] <- readv
  xs <- readv
  let valpos = DL.sortOn ((*(-1)).fst) $ zip xs [1..]
      ans = recurse [] [] (-1) 1 valpos
      (vals,poss) = unzip ans
      v = 2 * sum vals
  print v
  printv poss

recurse neg pos _ _ [] = neg ++ [(0,0)] ++ (reverse pos)
recurse neg pos this other ((v,p):valpos)
  | (this>0) = recurse neg ((v*this,p):pos) other (this+1) valpos
  | otherwise = recurse ((-v*this,p):neg) pos other (this-1) valpos

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

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

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


Nezzar's favorite digit among $$$1,\ldots,9$$$ is $$$d$$$. He calls a positive integer lucky if $$$d$$$ occurs at least once in its decimal representation. Given $$$q$$$ integers $$$a_1,a_2,\ldots,a_q$$$, for each $$$1 \le i \le q$$$ Nezzar would like to know if $$$a_i$$$ can be equal to a sum of several (one or more) lucky numbers.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 9$$$) — the number of test cases. The first line of each test case contains two integers $$$q$$$ and $$$d$$$ ($$$1 \le q \le 10^4$$$, $$$1 \le d \le 9$$$). The second line of each test case contains $$$q$$$ integers $$$a_1,a_2,\ldots,a_q$$$ ($$$1 \le a_i \le 10^9$$$).

For each integer in each test case, print "YES" in a single line if $$$a_i$$$ can be equal to a sum of lucky numbers. Otherwise, print "NO". You can print letters in any case (upper or lower).

YES
NO
YES
YES
YES
NO
YES
YES
YES
YES
YES
YES
NO

NoteIn the first test case, $$$24 = 17 + 7$$$, $$$27$$$ itself is a lucky number, $$$25$$$ cannot be equal to a sum of lucky numbers.

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. 1 + (x - d) `div` 10] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. d] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. 9] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"


The Little Elephant loves sortings.He has an array a consisting of n integers. Let's number the array elements from 1 to n, then the i-th element will be denoted as ai. The Little Elephant can make one move to choose an arbitrary pair of integers l and r (1 ≤ l ≤ r ≤ n) and increase ai by 1 for all i such that l ≤ i ≤ r.Help the Little Elephant find the minimum number of moves he needs to convert array a to an arbitrary array sorted in the non-decreasing order. Array a, consisting of n elements, is sorted in the non-decreasing order if for any i (1 ≤ i < n) ai ≤ ai + 1 holds.

The first line contains a single integer n (1 ≤ n ≤ 105) — the size of array a. The next line contains n integers, separated by single spaces — array a (1 ≤ ai ≤ 109). The array elements are listed in the line in the order of their index's increasing.

In a single line print a single integer — the answer to the problem. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteIn the first sample the array is already sorted in the non-decreasing order, so the answer is 0.In the second sample you need to perform two operations: first increase numbers from second to third (after that the array will be: [3, 3, 2]), and second increase only the last element (the array will be: [3, 3, 3]).In the third sample you should make at least 6 steps. The possible sequence of the operations is: (2; 3), (2; 3), (2; 3), (3; 3), (3; 3), (3; 3). After that the array converts to [7, 7, 7, 47].

import Control.Monad (liftM)

solve :: [Integer] -> Integer
solve [_]  =  0
solve (a : b : xs)
  | a <= b  =  solve (b : xs)
  | otherwise  =  (a - b) + solve (b : xs)

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

f :: [Integer] -> Integer
f (x:y:s) = (max 0 (x-y)) + (f$y:s)
f _ = 0
main=interact$show.f.map read.tail.words

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

readInteger s = let Just (n,_) = B.readInteger s in n

main = getLine >> B.getContents >>= print.solve 0.map readInteger.B.words

solve !cnt [] = cnt
solve !cnt [x] = cnt
solve !cnt (x:y:xs)
  | x<=y = solve cnt (y:xs)
  | otherwise = solve (cnt+x-y) (y:xs)

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

readInput :: IO [Integer]
readInput = do
  _ <- B.getLine
  map (fst . fromJust . B.readInteger) . B.words <$> B.getLine

solve :: [Integer] -> Integer
solve xs = sum $ zipWith (\a b -> max 0 (a - b)) xs (tail xs)

main :: IO ()
main = readInput >>= (print . solve)

f :: [Integer]->Integer

f (x:xs) = f' 0 x xs
  where
    f' n x [] = n
    f' n x (y:ys) | x > y + n = f' (n + (x - n - y)) x ys
    f' n x (y:ys) = f' n (y+n) ys

main = do
  num <- readLn
  nums <- getLine >>= (return.map read.take num.words)
  putStrLn (show (f nums))

import Control.Monad (liftM)

solve :: [Int] -> Int
solve [_]  =  0
solve (a : b : xs)
  | a <= b  =  solve (b : xs)
  | otherwise  =  (a - b) + solve (b : xs)

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

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

readInteger s = let Just (n,_) = B.readInteger s in n

main = getLine >> B.getContents >>= print.solve 0.map readInteger.B.words

solve !cnt [] = cnt
solve !cnt [x] = cnt
solve !cnt (x:y:xs)
  | x<=y = solve cnt (y:xs)
  | otherwise = solve (inc+cnt) gx
   where
     (lx,gx) = span (<x) xs
     inc = (x-) $ minimum $ y:lx


You are given an array $$$a$$$ consisting of $$$n$$$ distinct positive integers.Let's consider an infinite integer set $$$S$$$ which contains all integers $$$x$$$ that satisfy at least one of the following conditions: $$$x = a_i$$$ for some $$$1 \leq i \leq n$$$. $$$x = 2y + 1$$$ and $$$y$$$ is in $$$S$$$. $$$x = 4y$$$ and $$$y$$$ is in $$$S$$$.For example, if $$$a = [1,2]$$$ then the $$$10$$$ smallest elements in $$$S$$$ will be $$$\{1,2,3,4,5,7,8,9,11,12\}$$$.Find the number of elements in $$$S$$$ that are strictly smaller than $$$2^p$$$. Since this number may be too large, print it modulo $$$10^9 + 7$$$.

The first line contains two integers $$$n$$$ and $$$p$$$ $$$(1 \leq n, p \leq 2 \cdot 10^5)$$$. The second line contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ $$$(1 \leq a_i \leq 10^9)$$$. It is guaranteed that all the numbers in $$$a$$$ are distinct.

Print a single integer, the number of elements in $$$S$$$ that are strictly smaller than $$$2^p$$$. Remember to print it modulo $$$10^9 + 7$$$.

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

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

import qualified Data.IntSet as Set
import Data.Bits

prime :: Int
prime = 10^9 + 7

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = x + y -! prime

(-!) :: Int -> Int -> Int
infixl 6 -!
x -! y = let
  r = x - y
  in  r + prime .&. (r `shiftR` 999)

preds :: Int -> [Int]
preds x
  | x <= 0  = []
  | odd x   = x : preds (div x 2)
  | x `mod` 4 == 0  = x : preds (div x 4)
  | otherwise  = [x]

byScale :: Set.IntSet -> Int -> [Int]
byScale vs cutoff
  | Set.null vs  = repeat 0
  | otherwise  = let
      (s1, q, s2) = Set.splitMember cutoff vs
      s3 = if  q  then  Set.insert cutoff s2  else  s2
      in  Set.size s1 : byScale s3 (cutoff * 2)

mainFun :: SP Builder
mainFun = do
  n <- getInt
  p <- getInt
  a <- replicateM n getInt
  let
    vs = Set.fromList a
    seeds = Set.filter (all (`Set.notMember` vs) . drop 1 . preds) vs
    ins = byScale seeds 2
    cts = zipWith3 (\x y z -> x +! y +! z) (0 : cts) (0 : 0 : cts) ins
  pure $ putInts [foldl' (+!) 0 $ take p cts]

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

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

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

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

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

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


You are given an integer a that consists of n digits. You are also given a sequence of digits s of length m. The digit in position j (1 ≤ j ≤ m) of sequence s means that you can choose an arbitrary position i (1 ≤ i ≤ n) in a and replace the digit in the chosen position i with sj. Each element in the sequence s can participate in no more than one replacing operation.Your task is to perform such sequence of replacements, that the given number a gets maximum value. You are allowed to use not all elements from s.

The first line contains positive integer a. Its length n is positive and doesn't exceed 105. The second line contains sequence of digits s. Its length m is positive and doesn't exceed 105. The digits in the sequence s are written consecutively without any separators. The given number a doesn't contain leading zeroes.

Print the maximum value that can be obtained from a after a series of replacements. You are allowed to use not all elements from s. The printed number shouldn't contain any leading zeroes.

import Data.List
import Debug.Trace

solve :: String -> String -> String
solve a b = solve' a $ reverse $ sort b
    where
      solve'     []      _ = []
      solve'      x     [] = x
      solve' (x:xs) (y:ys)
          | x < y     = y : solve' xs ys
          | otherwise = x : solve' xs (y:ys)

main = do
  a <- getLine
  s <- getLine
  putStrLn $ solve a s

import List

solve :: String -> String -> IO ()
solve a s  =  solve' a (reverse $ sort s)
  where
    solve' :: String -> String -> IO ()
    solve' a []  =  putStrLn a
    solve' a (x:xs)
      | null t  =  putStrLn a
      | otherwise  =  putStr h >> putStr [x] >> solve' (tail t) xs
      where
        (h, t)  =  span (>= x) a

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

import List
g(a:b)(c:d)|c>a=c:g b d|1>0=a:g b(c:d)
g l _=l
s[a,b]=g a(reverse$sort b)
main=interact$s.words

import Data.List

main::IO ()
main = do
  cs <- getContents
  (putStr .solve.parseIn)  cs

parseIn::String->([Int],[Int])
parseIn s = (num,(reverse $ sort se))
    where
      [num,se] = map (\x -> map (\y->read [y]::Int) x) $ lines s

solve::([Int],[Int])->String
solve = concat . map show . solveS

solveS::([Int],[Int])->[Int]
solveS ([],_) = []
solveS (a,[])=a
solveS ((a:as),(b:bs))
    | (a>=b) = a:solveS(as,(b:bs))
    | otherwise = b:solveS(as,bs)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (reverse (a:as))++acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
import Data.Char
import qualified Data.Map as M

solve orig repl =
    reverse $ loop orig repl []

loop [] repl acc = acc
loop (o:os) repl acc =
    if getMax repl > o
    then loop os (decMax repl) ((getMax repl):acc)
    else loop os repl (o:acc)

getMax mset
    | M.null mset  = 0
    | otherwise    = fst $ M.findMax mset

decMax :: M.Map k Int -> M.Map k Int
decMax =
    M.updateMax (\x -> if x > 1 then Just (x-1) else Nothing)

makeMap l = M.fromList [(head x, length x) | x <- (group $ sort l)]

prepare = map intToDigit

main = do
  orig <- (getLine >>= (return . map digitToInt))
  repl <- (getLine >>= (return . map digitToInt))
  putStrLn . prepare $ solve orig (makeMap repl)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (reverse acc)++(a:as)
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n >= a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.show.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (a:as)++acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (a:as)++(reverse acc)
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
import Data.Char
import qualified Data.Map as M

solve orig repl =
    reverse $ loop orig repl []

loop [] repl acc = acc
loop (o:os) repl acc =
    if getMax repl > o
    then loop os (decMax repl) ((getMax repl):acc)
    else loop os repl (o:acc)

getMax mset =
    fst $ M.findMax mset

decMax :: M.Map k Int -> M.Map k Int
decMax =
    M.updateMax (\x -> if x > 1 then Just (x-1) else Nothing)

makeMap l = M.fromList [(head x, length x) | x <- (group $ sort l)]

main = do
  orig <- (getLine >>= (return . map digitToInt))
  repl <- (getLine >>= (return . map digitToInt))
  print $ solve orig (makeMap repl)


Marin wants you to count number of permutations that are beautiful. A beautiful permutation of length $$$n$$$ is a permutation that has the following property: $$$$$$ \gcd (1 \cdot p_1, \, 2 \cdot p_2, \, \dots, \, n \cdot p_n) > 1, $$$$$$ where $$$\gcd$$$ is the greatest common divisor.A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3, 4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of test cases. Each test case consists of one line containing one integer $$$n$$$ ($$$1 \le n \le 10^3$$$).

For each test case, print one integer — number of beautiful permutations. Because the answer can be very big, please print the answer modulo $$$998\,244\,353$$$.

NoteIn first test case, we only have one permutation which is $$$[1]$$$ but it is not beautiful because $$$\gcd(1 \cdot 1) = 1$$$.In second test case, we only have one beautiful permutation which is $$$[2, 1]$$$ because $$$\gcd(1 \cdot 2, 2 \cdot 1) = 2$$$.

md = 998244353
fact(x) = if x==0 then 1 else (x*fact(x-1))`mod`md
solve(t) =
    if t==0 then pure () else
    do
        x <- getLine
        let n = (read x :: Int)
        print(if n`mod`2==1 then 0 else (fact(n`div`2)*fact(n`div`2))`mod`md)
        solve(t-1)
main = do
    t <- getLine
    solve(read t :: Int)


Recently Vova found $$$n$$$ candy wrappers. He remembers that he bought $$$x$$$ candies during the first day, $$$2x$$$ candies during the second day, $$$4x$$$ candies during the third day, $$$\dots$$$, $$$2^{k-1} x$$$ candies during the $$$k$$$-th day. But there is an issue: Vova remembers neither $$$x$$$ nor $$$k$$$ but he is sure that $$$x$$$ and $$$k$$$ are positive integers and $$$k > 1$$$.Vova will be satisfied if you tell him any positive integer $$$x$$$ so there is an integer $$$k>1$$$ that $$$x + 2x + 4x + \dots + 2^{k-1} x = n$$$. It is guaranteed that at least one solution exists. Note that $$$k > 1$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains one integer $$$n$$$ ($$$3 \le n \le 10^9$$$) — the number of candy wrappers Vova found. It is guaranteed that there is some positive integer $$$x$$$ and integer $$$k>1$$$ that $$$x + 2x + 4x + \dots + 2^{k-1} x = n$$$.

Print one integer — any positive integer value of $$$x$$$ so there is an integer $$$k>1$$$ that $$$x + 2x + 4x + \dots + 2^{k-1} x = n$$$.

NoteIn the first test case of the example, one of the possible answers is $$$x=1, k=2$$$. Then $$$1 \cdot 1 + 2 \cdot 1$$$ equals $$$n=3$$$.In the second test case of the example, one of the possible answers is $$$x=2, k=2$$$. Then $$$1 \cdot 2 + 2 \cdot 2$$$ equals $$$n=6$$$.In the third test case of the example, one of the possible answers is $$$x=1, k=3$$$. Then $$$1 \cdot 1 + 2 \cdot 1 + 4 \cdot 1$$$ equals $$$n=7$$$.In the fourth test case of the example, one of the possible answers is $$$x=7, k=2$$$. Then $$$1 \cdot 7 + 2 \cdot 7$$$ equals $$$n=21$$$.In the fifth test case of the example, one of the possible answers is $$$x=4, k=3$$$. Then $$$1 \cdot 4 + 2 \cdot 4 + 4 \cdot 4$$$ equals $$$n=28$$$.

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        print $ f n

f :: Int -> Int
f n = n `div` (head $ filter (\x -> n `mod` x == 0) $ drop 1 $ scanl1 (+) $ takeWhile (<=n) $ iterate (*2) 1)

import Control.Monad

main =
    interact $
    unlines .
    map (show . (\n -> div n $ head $ filter ((==) 0 . mod n) $ subtract 1 . (^) 2 <$> [2 ..]) . read) . tail . words

solveFor :: Int -> Integer -> Integer
solveFor k n | n `mod` (2 ^ k - 1) == 0 = n `div` (2 ^ k - 1)
             | otherwise                = solveFor (k + 1) n

solveCase :: IO ()
solveCase = do
  nLine <- getLine
  let n   = read nLine :: Integer
  let res = solveFor 2 n
  print res

main :: IO ()
main = do
  tline <- getLine
  let ts = read tline :: Int
  sequence_ [ solveCase | _ <- [1 .. ts] ]

import Control.Monad

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

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

solve :: Int -> Int
solve n = n `div ` head filtered
  where
    powers = 4: map (*2) powers
    powers' = map (\x -> x-1) powers
    filtered = filter (\x -> n `mod` x ==0) powers'

import Control.Monad (replicateM_)

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

solveIO :: IO ()
solveIO = readLn >>= print . f

f :: Integer -> Integer
f n = fst . head . filter (\(_,c)->c==0) $ [(n `div` (2^k-1), n `mod` (2^k-1))  | k <- [2..]]

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

a= [2^i-1|i<-[2..35]]

onecase = do
	c<-  read <$> getLine ::IO Int
	let x = head $ filter (\z-> mod c z==0)  a
	print $ div c x

main = do

	n<-  read <$> getLine ::IO Int
	replicateM_ n onecase

process :: Int -> Int
process n = f 3
    where
        f t
            | n `mod` t == 0 = n `div` t
            | otherwise = f (2*t+1)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    print $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

solve :: Integer -> Integer -> Integer
solve n k = if mod n (2^k - 1) == 0 then div n (2^k - 1)
                                    else solve n (k+1)

parse :: String -> String
parse raw = show $ solve n 2
  where n = read raw :: Integer

main :: IO ()
main = interact (unlines . map parse . tail . lines)

import Control.Monad

main =
    interact $
    unlines .
    map (show . (\n -> div n $ head $ filter ((==) 0 . mod n) $ subtract 1 . (^) 2 <$> [2 ..]) . read) . words


DZY has a hash table with p buckets, numbered from 0 to p - 1. He wants to insert n numbers, in the order they are given, into the hash table. For the i-th number xi, DZY will put it into the bucket numbered h(xi), where h(x) is the hash function. In this problem we will assume, that h(x) = x mod p. Operation a mod b denotes taking a remainder after division a by b.However, each bucket can contain no more than one element. If DZY wants to insert an number into a bucket which is already filled, we say a "conflict" happens. Suppose the first conflict happens right after the i-th insertion, you should output i. If no conflict happens, just output -1.

The first line contains two integers, p and n (2 ≤ p, n ≤ 300). Then n lines follow. The i-th of them contains an integer xi (0 ≤ xi ≤ 109).

Output a single integer — the answer to the problem.

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

f :: Int -> [Int] -> Int
f p xs = if length a > 0
         then length xs - fromJust (elemIndex (fst $ last a) xs)
         else (-1)
    where
        h x = mod x p
        a = filter (\p -> g (fst p) (snd p)) $ zip xs (tail $ tails xs)
        g :: Int -> [Int] -> Bool
        g y ys = any (h y ==) $ map h ys

main = do
    [p, n] <- fmap (map read . words) getLine :: IO [Int]
    xs <- replicateM n readLn
    print $ f p $ reverse xs

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

solve :: [Int] -> Int
solve (p:_:x) = solve' [] 1 x
    where solve' :: [Int] -> Int -> [Int] -> Int
          solve' _ _ []     = -1
          solve' h i (x:xs) | elem (mod x p) h = i
                            | otherwise = solve' ((mod x p):h) (i + 1) xs

readInt x = read x :: Int
main = interact $ show . solve . (map readInt) . words

go os [] = -1
go os (x:xs) = if elem x os then 1 else p $ go (x:os) xs
	where p i = if i < 0 then i else i+1

solve (p:n:xs) = go [] $ map (`mod` p) xs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solve [] used nth = -1
solve (a:as) used nth
  | check == False = solve as newUsed (nth + 1)
  | otherwise = nth
  where check = Set.member a used
        newUsed = Set.insert a used

read_ints :: Int -> IO [Int]
read_ints 0 = return []
read_ints n = do
  a <- getint
  nxt <- read_ints (n - 1)
  return (a:nxt)

main = do
  [p, n] <- getints
  as <- map (`mod` p) <$> read_ints n
  putStrLn (show $ solve as Set.empty 1)

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

main = do
    [p,n] <- map (read :: String -> Int) . words <$> getLine
    xs <- replicateM n (readLn :: IO Int)
    let (as,b) = mapAccumL (\a b -> (((b`mod`p):head a):a,b`mod`p)) [[]] xs
        m = length $ takeWhile  (uncurry notElem) $ zip b $ reverse as
    print $ if m == n then -1 else m+1

import Data.List

f::Int->[Int]->[Int]->Int
f _ [] es=(-1)
f p (n:ns) es
    |(n `mod` p) `elem` es=(length es)+1
    |otherwise=f p ns ((n `mod` p):es)

main =do
      e<-getLine
      es<-getContents
      let (p:n:[])=map read (words e)::[Int]
          xs=map read (lines es)::[Int]
      print $ f p xs []

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

solve :: Int -> [Int] -> State (Set.Set Int) Int
solve p queries = do
    processedQueries <- forM queries $ \query -> do
        let value = query `mod` p
        has <- gets $ Set.member value
        if has
            then return False
            else (modify $ Set.insert value) >> return True
    let queryId = length . takeWhile id $ processedQueries
    if queryId == (length queries) then return (-1) else return (queryId + 1)

main :: IO ()
main = do
    [p, n] <- (map readB8Int) <$> B8.words <$> B8.getLine
    queries <- replicateM n $ readB8Int <$> B8.getLine
    let answer = (flip evalState) Set.empty $ solve p queries
    printf "%d\n" answer

import Control.Applicative
import Data.Set

solve :: Int -> [Int] -> Set Int -> Int
solve p (x:rst) set =
  if (x `mod` p) `member` set then 1 + (size set) else solve p rst (insert (x `mod` p) set)
solve _ [] _ = -1

main :: IO ()
main = do
  [p, _] <- Prelude.map read . words <$> getLine
  x <- Prelude.map read . lines <$> getContents
  putStrLn $ show $ solve p x Data.Set.empty

import Control.Applicative ((<$>), (<*>), (<|>))
import qualified Data.Set as S
import Data.Maybe (fromMaybe, listToMaybe)
import Data.List (mapAccumL)

main :: IO ()
main = solve <$> (head . map read . words <$> getLine) <*> (map read . words <$> getContents) >>= print

solve :: Int -> [Int] -> Int
solve p = fromMaybe (-1) . foldl (<|>) Nothing . snd . mapAccumL f S.empty . zip [1..] . map (`mod` p)
  where f s (i, x) = (S.insert x s, listToMaybe [ i | S.member x s ])

import Control.Applicative ((<$>), (<*>), (<|>))
import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = solve <$> (head . map read . words <$> getLine) <*> (map read . words <$> getContents) >>= print

solve :: Int -> [Int] -> Int
solve p = fromMaybe (-1) . foldl (<|>) Nothing . snd . mapAccumL f [] . zip [1..] . map (`mod` p)
  where f xs (i, x) = (x:xs, listToMaybe [ i | x `elem` xs ])

main=interact$show.f.map read.words
f(p:n:xs)=go [] 1 xs
   where
     go used i (x:xs)
       | h <- mod x p, elem h used = i
       | otherwise = go (mod x p:used) (i+1) xs
     go _ _ _ = -1

readLi :: Int -> IO [Int]
readLi 0 = return []
readLi n = do
	x <- fmap read getLine :: IO Int
	y <- readLi (n-1)
	return (x:y)

isTrue :: [Bool] -> Int -> Bool
isTrue (x:xs) 0 = x
isTrue (x:xs) n = isTrue xs (n-1)

putTrue :: [Bool] -> Int -> [Bool]
putTrue (x:xs) 0 = (True:xs)
putTrue (x:xs) n = x:putTrue xs (n-1)

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
	let y = x `mod` length al
	in if isTrue al y
		then pos + 1
		else firstEq xs (putTrue al y) (pos + 1)

main = do
	x <- fmap (map read . words) getLine :: IO [Int]
	let p = head x
	let n = last x
	l <- readLi n
	let al = [False | _ <- [1..p]]
	print $ firstEq l al 0

import Control.Applicative

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
    let y = x `mod` length al
    in if al!!y
        then pos + 1
        else firstEq xs (take y al ++ [True] ++ drop (y+1) al) (pos + 1)

main = do
    p <- head . map read . words <$> getLine
    l <- map read . lines <$> getContents
    print $ firstEq l [False | x <- [1..p]] 0

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
	let y = x `mod` length al
	in if al!!y
		then pos + 1
		else firstEq xs (take y al ++ [True] ++ drop (y+1) al) (pos + 1)

main = do
	x <- fmap (map read . words) getLine :: IO [Int]
	let p = head x
	let n = last x
	l <- fmap (map read . lines) getContents :: IO [Int]
	let al = [False | _ <- [1..p]]
	print $ firstEq l al 0

import qualified Data.Set as Set
c=go Set.empty where
  go s [] = -1
  go s (x : xs) = if Set.member x s then 1 else case go (Set.insert x s) xs of
     -1 -> -1
     n -> n + 1
s(p:_:n)=c$map(`mod`p)n
main=interact$show.s.map read.words

import Data.List
import Data.Function
import qualified Data.IntSet as IS
import Text.Printf (printf)
import Control.Monad

solve :: Int -> [Int] -> Int
solve p xs = go IS.empty 1 xs
  where
    hash x = x `mod` p
    go _ _ [] = -1
    go seen i (x : xs)
      | IS.member h seen = i
      | otherwise = go (IS.insert h seen) (i + 1) xs
      where h = hash x

main :: IO ()
main = do
  [p, n] <- fmap (map read . words) getLine :: IO [Int]
  xs <- replicateM n readLn
  print $ solve p xs

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

process n b x [] = -1
process n b x (c:cs)  	| S.member (mod c b) x = n
			| otherwise = process (n+1) b (S.insert (mod c b) x) cs

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		c<-map read <$> replicateM b getLine ::IO [Int]
		print $ process  1 a S.empty c

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solve [] used nth = -1
solve (a:as) used nth
  | check == False = solve as newUsed (nth + 1)
  | otherwise = nth
  where check = Set.member a used
        newUsed = Set.insert a used

read_ints :: Int -> IO [Int]
read_ints 0 = return []
read_ints n = do
  a <- getint
  nxt <- read_ints (n - 1)
  return (a:nxt)

main = do
  [p, n] <- getints
  as <- read_ints n
  putStrLn (show $ solve as Set.empty 0)

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

process n b x [] = -1
process n b x (c:cs)  	| S.member (mod c b) x = n
			| otherwise = process (n+1) b (S.insert (mod c b) x) cs

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		c<-map read <$> replicateM b getLine ::IO [Int]
		print $ process  1 b S.empty c


Two integer sequences existed initially — one of them was strictly increasing, and the other one — strictly decreasing.Strictly increasing sequence is a sequence of integers $$$[x_1 < x_2 < \dots < x_k]$$$. And strictly decreasing sequence is a sequence of integers $$$[y_1 > y_2 > \dots > y_l]$$$. Note that the empty sequence and the sequence consisting of one element can be considered as increasing or decreasing.They were merged into one sequence $$$a$$$. After that sequence $$$a$$$ got shuffled. For example, some of the possible resulting sequences $$$a$$$ for an increasing sequence $$$[1, 3, 4]$$$ and a decreasing sequence $$$[10, 4, 2]$$$ are sequences $$$[1, 2, 3, 4, 4, 10]$$$ or $$$[4, 2, 1, 10, 4, 3]$$$.This shuffled sequence $$$a$$$ is given in the input.Your task is to find any two suitable initial sequences. One of them should be strictly increasing and the other one — strictly decreasing. Note that the empty sequence and the sequence consisting of one element can be considered as increasing or decreasing.If there is a contradiction in the input and it is impossible to split the given sequence $$$a$$$ to increasing and decreasing sequences, print "NO".

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 2 \cdot 10^5$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

If there is a contradiction in the input and it is impossible to split the given sequence $$$a$$$ to increasing and decreasing sequences, print "NO" in the first line. Otherwise print "YES" in the first line and any two suitable sequences. Note that the empty sequence and the sequence consisting of one element can be considered as increasing or decreasing. In the second line print $$$n_i$$$ — the number of elements in the strictly increasing sequence. $$$n_i$$$ can be zero, in this case the increasing sequence is empty. In the third line print $$$n_i$$$ integers $$$inc_1, inc_2, \dots, inc_{n_i}$$$ in the increasing order of its values ($$$inc_1 < inc_2 < \dots < inc_{n_i}$$$) — the strictly increasing sequence itself. You can keep this line empty if $$$n_i = 0$$$ (or just print the empty line). In the fourth line print $$$n_d$$$ — the number of elements in the strictly decreasing sequence. $$$n_d$$$ can be zero, in this case the decreasing sequence is empty. In the fifth line print $$$n_d$$$ integers $$$dec_1, dec_2, \dots, dec_{n_d}$$$ in the decreasing order of its values ($$$dec_1 > dec_2 > \dots > dec_{n_d}$$$) — the strictly decreasing sequence itself. You can keep this line empty if $$$n_d = 0$$$ (or just print the empty line). $$$n_i + n_d$$$ should be equal to $$$n$$$ and the union of printed sequences should be a permutation of the given sequence (in case of "YES" answer).

import Data.List
process :: [Int] -> ([Int], [Int]) -> Maybe ([Int], [Int])
process (a:b:c:d) (x, y)
  | ((a == b) && (b == c)) = Nothing
  | (a == b) = process (c:d) (a:x, b:y)
  | otherwise = process (b:c:d) (a:x, y)
process [a, b] (x, y) = Just (a:x, b:y)
process [a] (x, y) = Just (a:x, y)
process [] (x, y) = Just (x, y)

output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ reverse a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ b
main = do
  _ <- getLine
  line <- getLine
  let
    a = sort $ map read $ words $ line
  output $ process a ([], [])

import Data.Array.Unboxed
hist :: (Int, Int) -> [Int] -> UArray Int Int
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i <- is, inRange bnds i]
process c (x, y) 0
  | (c!0) > 2 = Nothing
  | (c!0) == 2 = Just (0:x, 0:y)
  | (c!0) == 1 = Just (0:x, y)
  | otherwise = Just (x, y)
process c (x, y) i
  | (c!i) > 2 = Nothing
  | (c!i) == 2 = process c (i:x, i:y) (i - 1)
  | (c!i) == 1 = process c (i:x, y) (i - 1)
  | otherwise = process c (x, y) (i - 1)
output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ reverse b
main = do
  _ <- getLine
  line <- getLine
  let
    a = map read $ words $ line
    c = hist (0, 200005) a
  output $ process c ([], []) 200005

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
import Data.Array.Unboxed
import Data.Int
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

sYes = byteString $ C.pack "YES\n"
sNo = byteString $ C.pack "NO\n"

out l = intDec (length l) <> char7 '\n' <> (mconcat $ (intersperse (char7 ' ') l')) <> char7 '\n'
  where
    l' = map (\i -> intDec (fst i) ) l

solve :: [Int] -> Builder
solve (n:a) = if (maximum $ elems c) > 2 then sNo else res
  where
    !m = maximum a
    c = runSTUArray $ do
      d <- newArray (0, m) 0 :: ST s (STUArray s Int Int32)
      forM a $ \j -> readArray d j >>= ((writeArray d j) . succ)
      return d
    res = sYes <> (out s1) <> out (reverse s2)
    s1 = filter ( ( >= 1) . snd ) $ assocs c
    s2 = filter ( ( == 2) . snd ) $ assocs c

main :: IO ()
main = hPutBuilder stdout . solve . map ru . C.words =<< C.getContents

import Data.Array.Unboxed
hist :: (Int, Int) -> [Int] -> UArray Int Int
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i <- is, inRange bnds i]
process c (x, y) 0
  | (c!0) > 2 = Nothing
  | (c!0) == 2 = Just (0:x, 0:y)
  | (c!0) == 1 = Just (0:x, y)
  | otherwise = Just (x, y)
process c (x, y) i
  | (c!i) > 2 = Nothing
  | (c!i) == 2 = process c (i:x, i:y) (i - 1)
  | (c!i) == 1 = process c (i:x, y) (i - 1)
  | otherwise = process c (x, y) (i - 1)
output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ reverse a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ b
main = do
  _ <- getLine
  line <- getLine
  let
    a = map read $ words $ line
    c = hist (0, 200005) a
  output $ process c ([], []) 200005


Masha wants to open her own bakery and bake muffins in one of the n cities numbered from 1 to n. There are m bidirectional roads, each of whose connects some pair of cities.To bake muffins in her bakery, Masha needs to establish flour supply from some storage. There are only k storages, located in different cities numbered a1, a2, ..., ak.Unforunately the law of the country Masha lives in prohibits opening bakery in any of the cities which has storage located in it. She can open it only in one of another n - k cities, and, of course, flour delivery should be paid — for every kilometer of path between storage and bakery Masha should pay 1 ruble.Formally, Masha will pay x roubles, if she will open the bakery in some city b (ai ≠ b for every 1 ≤ i ≤ k) and choose a storage in some city s (s = aj for some 1 ≤ j ≤ k) and b and s are connected by some path of roads of summary length x (if there are more than one path, Masha is able to choose which of them should be used).Masha is very thrifty and rational. She is interested in a city, where she can open her bakery (and choose one of k storages and one of the paths between city with bakery and city with storage) and pay minimum possible amount of rubles for flour delivery. Please help Masha find this amount.

The first line of the input contains three integers n, m and k (1 ≤ n, m ≤ 105, 0 ≤ k ≤ n) — the number of cities in country Masha lives in, the number of roads between them and the number of flour storages respectively. Then m lines follow. Each of them contains three integers u, v and l (1 ≤ u, v ≤ n, 1 ≤ l ≤ 109, u ≠ v) meaning that there is a road between cities u and v of length of l kilometers . If k > 0, then the last line of the input contains k distinct integers a1, a2, ..., ak (1 ≤ ai ≤ n) — the number of cities having flour storage located in. If k = 0 then this line is not presented in the input.

Print the minimum possible amount of rubles Masha should pay for flour delivery in the only line. If the bakery can not be opened (while satisfying conditions) in any of the n cities, print  - 1 in the only line.

NoteImage illustrates the first sample case. Cities with storage located in and the road representing the answer are darkened.

import Data.Maybe
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.IntSet as Set

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

type Visited = Map.Map Int Bool
type Links = Map.Map Int [(Int,Int)] -- (dest, weight)

main = do
    [n,m,k] <- getInts
    edges <- replicateM m getInts   -- m numbers of [u,v,l]
    if k == 0 || k == n
    then print (-1)
    else do
        storages <- getInts             -- length: k
        let links = foldl mkLink Map.empty edges :: Links
        let storageCities = Set.fromList storages
        let inf = 10^9 + 7
        -- for each stroage, find the nearest empty city
        let soln = foldl findNearest inf storages where
            findNearest minCost storage = if costs == [] then minCost else min (minimum costs) minCost where
                costs = (map snd . filter notStorage) (neighbors storage)
                neighbors storage = if storage `Map.member` links then links Map.! storage else []
                notStorage (city,len) = city `Set.notMember` storageCities
        if soln == inf
        then print (-1)
        else print soln

mkLink links [u,v,l] = links2 where
    links1 = Map.insertWith (++) u [(v,l)] links
    links2 = Map.insertWith (++) v [(u,l)] links1

{-# OPTIONS_GHC -O #-}
import Data.List (foldl')
import Control.Monad
import Data.Array

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

inf = truncate 2e9 :: Int

main = do
    [n,m,k] <- readIntList
    a' <- forM [1..m] $ \_ -> do
        [u,v,l] <- readIntList
        return [(u,(v,l)),(v,(u,l))]
    let a = accumArray (\ls pr -> pr:ls) [] (1,n) $ concat a'
    if k == 0
        then print (-1)
        else do
            st <- readIntList
            let storage = accumArray (+) 0 (1,n) $ zip st [1,1..]
                solve x = foldl'(\acc (ch,len) -> if (storage!ch /= 1 && len < acc) then len else acc) (inf) (a!x)
                ans = minimum . map solve $ st
            if ans == inf then print (-1) else print ans

{-# OPTIONS_GHC -O #-}
import Data.List (foldl')
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Int]
 where fn x = let Just (y,_) = B.readInt x in y

inf = truncate 2e9 :: Int

main = do
    [n,m,k] <- readIntList
    a' <- forM [1..m] $ \_ -> do
        [u,v,l] <- readIntList
        return [(u,(v,l)),(v,(u,l))]
    let a = accumArray (\ls pr -> pr:ls) [] (1,n) $ concat a'
    if k == 0
        then print (-1)
        else do
            st <- readIntList
            let storage = accumArray (+) 0 (1,n) $ zip st [1,1..]
                solve x = foldl'(\acc (ch,len) -> if (storage!ch /= 1 && len < acc) then len else acc) (inf) (a!x)
                ans = minimum . map solve $ st
            if ans == inf then print (-1) else print ans

import qualified Data.Set as Set

main = interact $ show.g.parse.lines

parse xs = map (\x -> (map read (words x)) :: [Integer]) xs
g xs
  | (last (head xs)) == 0 = (-1)
  | otherwise = f (init ys) (Set.fromList (last ys)) infinity
  where ys = tail xs

infinity = (read "Infinity")::Double

f [] ys cost
  | cost == infinity = (-1)
  | otherwise = floor cost
f (x:xs) ys cost
  | (a && (not b)) || ((not a) && b) = f xs ys (min cost c)
  | otherwise = f xs ys cost
  where a = Set.member (head x) ys
        b = Set.member (head (tail x)) ys
        c = fromIntegral (last x)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (accumArray, (!))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.List (minimumBy)
import Data.Ord (comparing)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, m, k] <- readInts
  es <- replicateM m readInts

  as <- if k > 0 then readInts else return []

  let
    as' = accumArray (flip const) False (1, n) $ zip as (repeat True)

    cs = filter f es
      where
        f [u, v, _] = as'!u && (not $ as'!v) || as'!v && (not $ as'!u)

    [_, _, r] = minimumBy (comparing (\[_, _, w] -> w)) cs

  if null cs
     then print $ -1
     else print r

import Control.Applicative
import Control.Monad
import Data.Set (Set, member, fromList)

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

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		let ls = [l | [u, v, l] <- g, xor (u `member` a) (v `member` a)]
		print $ if null ls then -1 else minimum ls

xor a b = (not a && b) || (a && not b)

import Control.Applicative
import Control.Monad
import Data.Array.IO.Safe
import qualified Data.Set

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[n, m, k] <- map read . words <$> getLine :: IO [Int]
	graph <- newArray (1, n) [] :: IO (IOArray Int [(Int, Int)])

	forM_ [1..m] $ \_ -> do
		[u, v, l] <- map read . words <$> getLine :: IO	[Int]
		modifyArray graph u ((v, l):)
		modifyArray graph v ((u, l):)

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- Data.Set.fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		ls <- concat <$> (forM [1..n] $ \u -> do
			gu <- readArray graph u
			return [l | (v, l) <- gu, u `Data.Set.member` a, v `Data.Set.notMember` a])

		print $ if null ls then -1 else minimum ls

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  storageCity :: Int -> IO [Int]
  storageCity 0 = return []
  storageCity _ = getLine >>= return . (map readInt) . words

  eelem :: Int -> S.Set Int -> Bool
  eelem y xs =
    let found = y `S.lookupIndex` xs
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  isStoragePath :: S.Set Int -> [Int] -> Bool
  isStoragePath storages path =
      let checkPath1 = not $ (path !! 1) `eelem` storages
          checkPath2 = not $ (path !! 0) `eelem` storages
          path1isStorage = (path !! 0) `eelem` storages
          path2isStorage = (path !! 1) `eelem` storages
          in (path1isStorage && (not path2isStorage)) || (path2isStorage && (not path1isStorage))

  getMinimumPrice :: [[Int]] -> Int
  getMinimumPrice [] = -1
  getMinimumPrice storagePath = minimum $ (map (!!2)) storagePath

  main :: IO()
  main = do
    [n,m,k] <- getLine >>= return . (map readInt) . words
    paths <- readMultilineInput m (return . (map readInt)  . words)
    storageList <- storageCity k
    let storages = S.fromList storageList
        storagePath = filter (isStoragePath storages) paths
        minimumPrice = getMinimumPrice storagePath
    putStrLn $ show minimumPrice

import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>), (<*>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

import Control.Monad (replicateM)
import Data.Set (Set, empty, fromList, member)

solve :: [(Int, Int, Int)] -> Set Int -> Int
solve e s = if out /= maxBound then out else -1
    where
    out = foldr go maxBound e :: Int
    go :: (Int, Int, Int) -> Int -> Int
    go (u, v, c) acc
        | acc < c + 1  = acc
        | u `member` s = if v `member` s then acc else c
        | otherwise    = if v `member` s then c else acc

parse :: ByteString -> [Int]
parse = unfoldr (B.readInt . B.dropWhile (== ' '))

main :: IO ()
main = do
    _:m:k:_ <- parse <$> getLine
    e <- map ((\[u, v, c] -> (u, v, c)) . parse) <$> replicateM m getLine
    if k /= 0 then getLine >>= print . solve e . fromList . parse
    else print $ solve e empty

module Main where

import Control.Monad
import Prelude
import Text.Printf
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Set as Set

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

infinity = 10000000000 :: Int

findBest :: [(Int, Int, Int)] -> (Set.Set Int) -> Int
findBest [] s = infinity
findBest ((a, b, l):es) s | (Set.member a s) /= (Set.member b s) = l `min` v
                          | otherwise                            = v
                          where v = findBest es s

solve :: Tokenizer Int
solve = do
    n <- nextInt
    m <- nextInt
    k <- nextInt
    edges <- replicateM m $ do
        a <- nextInt
        b <- nextInt
        l <- nextInt
        return (a, b, l)
    as <- replicateM k $ do
        nextInt
    let bs = Set.fromList as
    let res = findBest edges bs
    if res >= infinity then return (-1)
    else return (res)

main = do
    contents <- L.getContents
    let ans = evalState solve (L.words contents)
    print ans

import qualified Data.Set as Set

main = interact $ show.g.parse.tail.lines

parse xs = map (\x -> (map read (words x)) :: [Integer]) xs
g xs = f (init xs) (Set.fromList (last xs)) infinity

infinity = (read "Infinity")::Double

f [] ys cost
  | cost == infinity = (-1)
  | otherwise = floor cost
f (x:xs) ys cost
  | (a && (not b)) || ((not a) && b) = f xs ys (min cost c)
  | otherwise = f xs ys cost
  where a = Set.member (head x) ys
        b = Set.member (head (tail x)) ys
        c = fromIntegral (last x)

import Control.Applicative
import Control.Monad
import Data.Set (Set, member, notMember, fromList)

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

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		let ls = [l | [u, v, l] <- g, u `member` a, v `notMember` a]
		print $ if null ls then -1 else minimum ls


Polycarp has spent the entire day preparing problems for you. Now he has to sleep for at least $$$a$$$ minutes to feel refreshed.Polycarp can only wake up by hearing the sound of his alarm. So he has just fallen asleep and his first alarm goes off in $$$b$$$ minutes.Every time Polycarp wakes up, he decides if he wants to sleep for some more time or not. If he's slept for less than $$$a$$$ minutes in total, then he sets his alarm to go off in $$$c$$$ minutes after it is reset and spends $$$d$$$ minutes to fall asleep again. Otherwise, he gets out of his bed and proceeds with the day.If the alarm goes off while Polycarp is falling asleep, then he resets his alarm to go off in another $$$c$$$ minutes and tries to fall asleep for $$$d$$$ minutes again.You just want to find out when will Polycarp get out of his bed or report that it will never happen.Please check out the notes for some explanations of the example.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. The only line of each testcase contains four integers $$$a, b, c, d$$$ ($$$1 \le a, b, c, d \le 10^9$$$) — the time Polycarp has to sleep for to feel refreshed, the time before the first alarm goes off, the time before every succeeding alarm goes off and the time Polycarp spends to fall asleep.

For each test case print one integer. If Polycarp never gets out of his bed then print -1. Otherwise, print the time it takes for Polycarp to get out of his bed.

NoteIn the first testcase Polycarp wakes up after $$$3$$$ minutes. He only rested for $$$3$$$ minutes out of $$$10$$$ minutes he needed. So after that he sets his alarm to go off in $$$6$$$ minutes and spends $$$4$$$ minutes falling asleep. Thus, he rests for $$$2$$$ more minutes, totaling in $$$3+2=5$$$ minutes of sleep. Then he repeats the procedure three more times and ends up with $$$11$$$ minutes of sleep. Finally, he gets out of his bed. He spent $$$3$$$ minutes before the first alarm and then reset his alarm four times. The answer is $$$3+4 \cdot 6 = 27$$$.The second example is almost like the first one but Polycarp needs $$$11$$$ minutes of sleep instead of $$$10$$$. However, that changes nothing because he gets $$$11$$$ minutes with these alarm parameters anyway.In the third testcase Polycarp wakes up rested enough after the first alarm. Thus, the answer is $$$b=9$$$.In the fourth testcase Polycarp wakes up after $$$5$$$ minutes. Unfortunately, he keeps resetting his alarm infinitely being unable to rest for even a single minute :(

main = interact $ f . map (map read) . map words . tail . lines

g (a:b:c:d:_)
  | b >= a = b
  | d >= c = -1
  | otherwise = b + (c*rans)
  where i = (a - b)
        interv = c-d
        ans = quot i interv
        r = rem i interv
        rans = if r==0 then ans else ans+1

f xs = unlines (map show (map g xs))

import Data.List

solve :: String -> String
solve s = intercalate "\n" $ map show $ solve' $ map read $ drop 1 $ words s

solve' :: [Integer] -> [Integer]
solve' (a:b:c:d:s) = (solve'' a b c d) : (solve' s)
solve' [] = []

solve'' :: Integer -> Integer -> Integer -> Integer -> Integer
solve'' a b c d =
  if a <= b
    then b
    else
     if restPerWake > 0
      then ((a - b + restPerWake - 1) `div` restPerWake) * c + b
      else -1
  where
    restPerWake = c - d

main :: IO ()
main = interact solve

import Control.Monad

-- parse :: [String] -> [[Integer]]
-- parse = map (\l -> map read . words $ l)

solve :: [Integer]->Integer
solve (a:b:c:d:[])
  | a<=b = b
  | c<=d = -1
  | otherwise = b + c*(div' needSleep timeAsleep)
    where needSleep = (a-b)
          timeAsleep = (c-d)

div' :: Integer -> Integer -> Integer
div' a b
  | a `mod` b == 0 = div a b
  | otherwise = 1+(div a b)

testCase :: Int -> IO ()
testCase 0 = return ()
testCase t = do
  test <- getLine
  putStrLn . show . solve . map read . words $ test
  testCase (t-1)

main :: IO ()
main = do
  n <- getLine
  testCase . read $ n
  --content <- replicateM (read n :: Int) getLine
  -- putStrLn . unlines . map (show . solve) . parse $ content

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Integer

solve :: Long -> Long -> Long -> Long -> Long
solve a b c d
    | a <= b    = b
    | otherwise =
        case solve' (a-b) c d of
            Nothing -> -1
            Just ans -> b+ans

ceilDiv a b
    | a `mod` b == 0    = a `div` b
    | otherwise         = 1 + (a `div` b)

solve' :: Long -> Long -> Long -> Maybe Long
solve' a c d
    | d >= c    = Nothing
    | otherwise = Just $ c * ceilDiv a (c-d)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (a:b:c:d:_) <- readWords
    print $ solve a b c d
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

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

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

onecase = do
		[a,b,c,d]<-map read <$> words <$> getLine ::IO [Integer]
		print $ if a <=b then b
				 else if d>=c then (-1)
				      else b+ c*((div (a-b) (c-d))+if mod (a-b) (c-d) >0 then 1 else 0)

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

main = interact $ f . map (map read) . map words . tail . lines

g (a:b:c:d:_)
  | b > a = b
  | d >= c = -1
  | otherwise = b + (c*rans)
  where i = (a - b)
        interv = c-d
        ans = quot i interv
        r = rem i interv
        rans = if r==0 then ans else ans+1

f xs = unlines (map show (map g xs))

import Data.List

solve :: String -> String
solve s = intercalate "\n" $ map show $ solve' $ map read $ drop 1 $ words s

solve' :: [Int] -> [Int]
solve' (a:b:c:d:s) = (solve'' a b c d) : (solve' s)
solve' [] = []

solve'' :: Int -> Int -> Int -> Int -> Int
solve'' a b c d =
  if a <= b
    then b
    else
     if restPerWake > 0
      then ((a - b + restPerWake - 1) `div` restPerWake) * c + b
      else -1
  where
    restPerWake = c - d

main :: IO ()
main = interact solve

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Int

solve :: Long -> Long -> Long -> Long -> Long
solve a b c d
    | a <= b    = b
    | otherwise =
        case solve' (a-b) c d of
            Nothing -> -1
            Just ans -> b+ans

ceilDiv a b
    | a `mod` b == 0    = a `div` b
    | otherwise         = 1 + (a `div` b)

solve' :: Long -> Long -> Long -> Maybe Long
solve' a c d
    | d >= c    = Nothing
    | otherwise = Just $ c * ceilDiv a (c-d)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (a:b:c:d:_) <- readWords
    print $ solve a b c d
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

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


A colored stripe is represented by a horizontal row of n square cells, each cell is pained one of k colors. Your task is to repaint the minimum number of cells so that no two neighbouring cells are of the same color. You can use any color from 1 to k to repaint the cells.

The first input line contains two integers n and k (1 ≤ n ≤ 5·105; 2 ≤ k ≤ 26). The second line contains n uppercase English letters. Letter "A" stands for the first color, letter "B" stands for the second color and so on. The first k English letters may be used. Each letter represents the color of the corresponding cell of the stripe.

Print a single integer — the required minimum number of repaintings. In the second line print any possible variant of the repainted stripe.

import Control.Arrow

main = do
  [n, m] <- fmap (map read . words) getLine
  s <- getLine
  let (x, y) = gao m s
  print x
  putStrLn y

gao 2 s = min (go s $ cycle "AB") (go s $ cycle "BA")
  where
    go a b = (length $ filter id $ zipWith (/=) a b, take (length a) b)

gao _ s = go s
  where
    go (x:y:z)
      | x == y    = first succ $ second ([x,y']++) $ go z
      | otherwise = second (x:) $ go (y:z)
      where
        z' = if null z then x else head z
        y' = head $ filter (`notElem`[x,z']) "ABC"
    go s = (0, s)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char

{-computeColor colour1 colour2 numberOfColours =
      chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
 -}

computeColour colour1 colour2 numberOfColours =
  let
       newColour = chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
  in
       if (newColour /= colour2) then newColour
       else chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 2) numberOfColours))

generateTwoColourStripes stripeLength =
   let generateTwoColourStripes_aux strpLen 'A' result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'B' ('A' : result)
       generateTwoColourStripes_aux strpLen _ result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'A' ('B' : result)
   in generateTwoColourStripes_aux stripeLength 'A' []

solveTwo stripe stripeLength =
  let (startingWithA,startingWithB) = generateTwoColourStripes stripeLength
      computeChanges [] _ numOfChanges = numOfChanges
      computeChanges (h1 : t1) (h2 : t2) numOfChanges =
              if (h1 == h2) then computeChanges t1 t2 numOfChanges
              else computeChanges t1 t2 (numOfChanges+1)
  in
     let numOfChangesStartingWith_A = computeChanges stripe startingWithA 0
         numOfChangesStartingWith_B = computeChanges stripe startingWithB 0
     in
         if (numOfChangesStartingWith_A < numOfChangesStartingWith_B) then
            (numOfChangesStartingWith_A,startingWithA)
         else
             (numOfChangesStartingWith_B,startingWithB)

solveMany stripe numberOfColours =
  let solve_aux [] numberOfchanges result = (numberOfchanges, (reverse result))
      solve_aux (h : rest) numberOfchanges result =
	    if ((head result) == h) then
                 if (rest == []) then
                       solve_aux rest (numberOfchanges+1) ((computeColour h h numberOfColours) : result)
                 else
                       solve_aux rest (numberOfchanges+1) ((computeColour h (head rest) numberOfColours) : result)
            else  solve_aux rest numberOfchanges (h : result)
  in
      solve_aux (tail stripe) 0 [(head stripe)]

solve stripe numberOfColours stripeLength =
   if (numberOfColours > 2) then solveMany stripe numberOfColours
   else solveTwo stripe stripeLength

main = do
  all <- getContents
  let (sl : nc : stripe : ignore) = words all
  let stringLength = ((read sl) :: Int)
  let numberOfColours = ((read nc) :: Int)
  let (numberOfChanges,solution) = solve stripe numberOfColours stringLength
  print numberOfChanges
  putStrLn solution
{-  let (startingWithA,startingWithB) = generateTwoColourStripes 10
  print startingWithA
  print startingWithB
  print stringLength
  print numberOfColours
  print stripe-}

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char

{-computeColor colour1 colour2 numberOfColours =
      chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
 -}

computeColour colour1 colour2 numberOfColours =
  let
       newColour = chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
  in
       if (newColour /= colour2) then newColour
       else chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 2) numberOfColours))

generateTwoColourStripes stripeLength =
   let generateTwoColourStripes_aux strpLen 'A' result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'B' ('A' : result)
       generateTwoColourStripes_aux strpLen _ result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'A' ('B' : result)
   in generateTwoColourStripes_aux stripeLength 'A' []

solveTwo stripe stripeLength =
  let (startingWithA,startingWithB) = generateTwoColourStripes stripeLength
      computeChanges [] _ numOfChanges = numOfChanges
      computeChanges (h1 : t1) (h2 : t2) numOfChanges =
              if (h1 == h2) then computeChanges t1 t2 numOfChanges
              else computeChanges t1 t2 (numOfChanges+1)
  in
     let numOfChangesStartingWith_A = computeChanges stripe startingWithA 0
         numOfChangesStartingWith_B = computeChanges stripe startingWithB 0
     in
         if (numOfChangesStartingWith_A < numOfChangesStartingWith_B) then
            (numOfChangesStartingWith_A,startingWithA)
         else
             (numOfChangesStartingWith_B,startingWithB)

solveMany stripe numberOfColours =
  let solve_aux [] numberOfchanges result = (numberOfchanges, (reverse result))
      solve_aux (h : rest) numberOfchanges result =
	    if ((head result) == h) then
                 if (rest == []) then
                       solve_aux rest (numberOfchanges+1) ((computeColour h h numberOfColours) : result)
                 else
                       solve_aux rest (numberOfchanges+1) ((computeColour h (head rest) numberOfColours) : result)
            else  solve_aux rest numberOfchanges (h : result)
  in
      solve_aux (tail stripe) 0 [(head stripe)]

solve stripe numberOfColours stripeLength =
   if (numberOfColours > 2) then solveMany stripe numberOfColours
   else solveTwo stripe stripeLength

main = do
  all <- getContents
  let (sl : nc : stripe : ignore) = words all
  let stringLength = ((read sl) :: Int)
  let numberOfColours = ((read nc) :: Int)
  let (numberOfChanges,solution) = solve stripe numberOfColours stringLength
  print numberOfChanges
  print solution
{-  let (startingWithA,startingWithB) = generateTwoColourStripes 10
  print startingWithA
  print startingWithB
  print stringLength
  print numberOfColours
  print stripe-}


A group of n schoolboys decided to ride bikes. As nobody of them has a bike, the boys need to rent them.The renting site offered them m bikes. The renting price is different for different bikes, renting the j-th bike costs pj rubles.In total, the boys' shared budget is a rubles. Besides, each of them has his own personal money, the i-th boy has bi personal rubles. The shared budget can be spent on any schoolchildren arbitrarily, but each boy's personal money can be spent on renting only this boy's bike.Each boy can rent at most one bike, one cannot give his bike to somebody else.What maximum number of schoolboys will be able to ride bikes? What minimum sum of personal money will they have to spend in total to let as many schoolchildren ride bikes as possible?

The first line of the input contains three integers n, m and a (1 ≤ n, m ≤ 105; 0 ≤ a ≤ 109). The second line contains the sequence of integers b1, b2, ..., bn (1 ≤ bi ≤ 104), where bi is the amount of the i-th boy's personal money. The third line contains the sequence of integers p1, p2, ..., pm (1 ≤ pj ≤ 109), where pj is the price for renting the j-th bike.

Print two integers r and s, where r is the maximum number of schoolboys that can rent a bike and s is the minimum total personal money needed to rent r bikes. If the schoolchildren cannot rent any bikes, then r = s = 0.

NoteIn the first sample both schoolchildren can rent a bike. For instance, they can split the shared budget in half (5 rubles each). In this case one of them will have to pay 1 ruble from the personal money and the other one will have to pay 2 rubles from the personal money. In total, they spend 3 rubles of their personal money. This way of distribution of money minimizes the amount of spent personal money.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (zipWith f (drop (n-k) bs) ps)
    where
    f bi pi = max 0 (fromIntegral (pi - bi))
    go a _ | a < 0 = False
    go a (x:xs) = go (a-x) xs
    go a [] = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = sum (zipWith f (drop (n-k) bs) ps) <= fromIntegral a
    where
    f bi pi = max 0 (fromIntegral (pi - bi)) :: Int64

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= fromIntegral a
    where
    f bi pi = max 0 (fromIntegral (pi - bi)) :: Int64

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (drop (n-k) bs) ps
    where
    {-# INLINE go #-}
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (drop (n-k) bs) ps
    where
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = go a (reverse (take k bs)) ps
    where
    {-# INLINE go #-}
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = go a (reverse (take k bs)) ps
    where
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= a
    where
    f bi pi = max 0 (pi - bi)

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    when (a == 399) $ do
        let bs' = map (head &&& length) $ group $ bs
        let ps' = map (head &&& length) $ group $ ps
        print bs'
        print ps'
    printf "%d %d\n" r s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= a
    where
    f bi pi = max 0 (pi - bi)

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s


Let's call a string adorable if its letters can be realigned in such a way that they form two consequent groups of equal symbols (note that different groups must contain different symbols). For example, ababa is adorable (you can transform it to aaabb, where the first three letters form a group of a-s and others — a group of b-s), but cccc is not since in each possible consequent partition letters in these two groups coincide.You're given a string s. Check whether it can be split into two non-empty subsequences such that the strings formed by these subsequences are adorable. Here a subsequence is an arbitrary set of indexes of the string.

The only line contains s (1 ≤ |s| ≤ 105) consisting of lowercase latin letters.

Print «Yes» if the string can be split according to the criteria above or «No» otherwise. Each letter can be printed in arbitrary case.

NoteIn sample case two zzcxx can be split into subsequences zc and zxx each of which is adorable.There's no suitable partition in sample case three.

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

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

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

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

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

main = getLine >>= putStrLn . which "Yes" "No" . solve . sort . map length . group . sort

solve [ a, b ] = 2 <= a && 2 <= b
solve [ a, b, c ] = 2 <= c
solve [ a, b, c, d ] = True
solve _ = False

import qualified Data.Map as Map

func :: String -> String
func str =
    let mp = Map.toList $ helper str Map.empty where
            helper :: String -> Map.Map Char Int -> Map.Map Char Int
            helper (s:ss) m = case Map.lookup s m of
                Nothing -> helper ss (Map.insert s 1 m)
                Just(v)-> helper ss (Map.insert s (v + 1) m)
            helper _ m = m
    in
        if (length mp) > 4 || (length mp) < 2 || (length str) < 4  then "NO"
        else if (length mp) == 2 && (length (filter (\x -> (snd x) == 1) mp)) > 0 then "NO"
        else "YES"

main :: IO ()
main = do
    l <- getLine
    putStrLn $ func l
    return ()

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; xs@[_, _, _] | last xs > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, _, b] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

module Main where

import Data.List (group, sort)

output :: Bool -> IO ()
output b = putStrLn $ if b then "Yes" else "No"

solve :: String -> Bool
solve str = case map length . group . sort $ str of
  [m, n] -> m >= 2 && n >= 2
  [m, n, k] -> m + n + k >= 4
  [_, _, _, _] -> True
  _ -> False

main :: IO ()
main = output . solve =<< getLine

import qualified Data.Map as Map

func :: String -> String
func str =
    let mp = Map.toList $ helper str Map.empty where
            helper :: String -> Map.Map Char Int -> Map.Map Char Int
            helper (s:ss) m = case Map.lookup s m of
                Nothing -> helper ss (Map.insert s 1 m)
                Just(v)-> helper ss (Map.insert s (v + 1) m)
            helper _ m = m
    in
        if (length mp) > 4 || (length mp) < 2  then "NO"
        else if (length mp) == 2 && (length (filter (\x -> (snd x) == 1) mp)) > 0 then "NO"
        else "YES"

main :: IO ()
main = do
    l <- getLine
    putStrLn $ func l
    return ()

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, b, _] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= print . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, b, _] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = interact exec
exec = (\case { [a, b] | a > 1 -> "Yes"; [a, b, c] | b > 1 -> "Yes";  [a, b, c, d] -> "Yes"; _ -> "No" }) . sort . map length . group . sort