This is an interactive problem. In the output section below you will see the information about flushing the output.Bear Limak thinks of some hidden number — an integer from interval [2, 100]. Your task is to say if the hidden number is prime or composite.Integer x > 1 is called prime if it has exactly two distinct divisors, 1 and x. If integer x > 1 is not prime, it's called composite.You can ask up to 20 queries about divisors of the hidden number. In each query you should print an integer from interval [2, 100]. The system will answer "yes" if your integer is a divisor of the hidden number. Otherwise, the answer will be "no".For example, if the hidden number is 14 then the system will answer "yes" only if you print 2, 7 or 14.When you are done asking queries, print "prime" or "composite" and terminate your program.You will get the Wrong Answer verdict if you ask more than 20 queries, or if you print an integer not from the range [2, 100]. Also, you will get the Wrong Answer verdict if the printed answer isn't correct.You will get the Idleness Limit Exceeded verdict if you don't print anything (but you should) or if you forget about flushing the output (more info below).

After each query you should read one string from the input. It will be "yes" if the printed integer is a divisor of the hidden number, and "no" otherwise.

Up to 20 times you can ask a query — print an integer from interval [2, 100] in one line. You have to both print the end-of-line character and flush the output. After flushing you should read a response from the input. In any moment you can print the answer "prime" or "composite" (without the quotes). After that, flush the output and terminate your program. To flush you can use (just after printing an integer and end-of-line):    fflush(stdout) in C++;  System.out.flush() in Java;  stdout.flush() in Python;  flush(output) in Pascal;  See the documentation for other languages.  Hacking. To hack someone, as the input you should print the hidden number — one integer from the interval [2, 100]. Of course, his/her solution won't be able to read the hidden number from the input.

NoteThe hidden number in the first query is 30. In a table below you can see a better form of the provided example of the communication process.The hidden number is divisible by both 2 and 5. Thus, it must be composite. Note that it isn't necessary to know the exact value of the hidden number. In this test, the hidden number is 30.59 is a divisor of the hidden number. In the interval [2, 100] there is only one number with this divisor. The hidden number must be 59, which is prime. Note that the answer is known even after the second query and you could print it then and terminate. Though, it isn't forbidden to ask unnecessary queries (unless you exceed the limit of 20 queries).

import Control.Monad
import Control.Applicative
import System.IO

main = do
  let ns = [2, 3, 4, 5, 7, 9, 11, 13, 17, 19, 23, 25, 29, 31, 37, 41, 43, 47, 49]
  ans <- mapM solve ns
  putStrLn $ if (length $ filter (== "yes") ans) <= 1
             then "prime" else "composite"
  hFlush stdout

solve n = do
  putStrLn $ show n
  hFlush stdout
  m <- getLine
  return m

import Control.Monad
import Control.Applicative
import System.IO

main = do
  let ns = [2, 3, 4, 5, 7, 9, 11, 13, 17, 19, 23, 25, 29, 31, 37, 41, 43, 47, 49, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]
  ans <- mapM solve ns
  putStrLn $ if (length $ filter (== "yes") ans) == 1
             then "prime" else "composite"
  hFlush stdout

solve n = do
  putStrLn $ show n
  hFlush stdout
  m <- getLine
  return m

import Control.Monad
import Control.Applicative
import System.IO

main = do
  let ns = [2, 3, 4, 5, 7, 9, 11, 13, 17, 19, 23, 25, 29, 31, 37, 41, 43, 47, 49]
  ans <- mapM solve ns
  putStrLn $ if (length $ filter (== "yes") ans) == 1
             then "prime" else "composite"
  hFlush stdout

solve n = do
  putStrLn $ show n
  hFlush stdout
  m <- getLine
  return m


Toastman came up with a very easy task. He gives it to Appleman, but Appleman doesn't know how to solve it. Can you help him?Given a n × n checkerboard. Each cell of the board has either character 'x', or character 'o'. Is it true that each cell of the board has even number of adjacent cells with 'o'? Two cells of the board are adjacent if they share a side.

The first line contains an integer n (1 ≤ n ≤ 100). Then n lines follow containing the description of the checkerboard. Each of them contains n characters (either 'x' or 'o') without spaces.

Print "YES" or "NO" (without the quotes) depending on the answer to the problem.

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

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

main :: IO ()
main = LC.interact $ LC.pack . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even transform) then "YES" else "NO"
          where
              transform = zipWith (+) (concat . map add $ a) (concat . L.transpose . map add $ L.transpose a)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

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

main :: IO ()
main = LC.interact $ LC.pack . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even f3) then "YES" else "NO"
          where
              f1 = map add a
              f2 = map add $ L.transpose a
              f3 = zipWith (+) (concat f1) (concat $ L.transpose f2)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

main = interact $ getAns . map (map (\x -> if x == 'o' then 1 else 0)) . tail . lines

shiftL x = tail x ++ [0]

shiftR x = 0 : init x

crossAdd x = zipWith (+) (shiftL x) (shiftR x)

getAns :: [[Int]] -> String
getAns x = let na = map crossAdd x;
			   nb = map crossAdd $ transpose x;
			   nc = zipWith (+) (concat na) $ (concat $ transpose nb);
		   in if (all even nc) then "YES" else "NO"

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

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

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

main = do
  n <- readLn
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, n)) $ concat a :: UArray (Int, Int) Char

    b = and [f i j | i <- [1..n], j <- [1..n]]
      where
        f i j = even $ length [(ii, jj) | (ii, jj) <- [(i+1,j), (i-1,j), (i,j-1), (i,j+1)], 1 <= ii && ii <= n && 1 <= jj && jj <= n, a'!(ii, jj) == 'o']

  putStrLn $ if b then "YES" else "NO"

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | not $ symmetrical matrix = "NO"
    | not $ symmetrical $ reverse matrix = "NO"
    | otherwise = "YES"
    where symmetrical m = m == transpose m

process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO String
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = takeWhile (/='\r') . B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

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

solve :: [String] -> Bool
solve (ns:cs) = all even [ length [ () | (di, dj) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                                       , 0 <= i + di, i + di < n
                                       , 0 <= j + dj, j + dj < n
                                       , cs !! (i + di) !! (j + dj) == 'o' ]
                                       | i <- [0..n-1], j <- [0..n-1] ]
  where n = read ns

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

import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let neighbors (i,j) = filter (inRange (bounds g)) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
  putStrLn $ if all (even . length . filter ((== 'o') . (g!)) . neighbors)  (indices g) then "YES" else "NO"

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  n <- read <$> getLine
  board <- replicateM n $ getLine
  putStrLn $ solve board

solve :: [[Char]] -> String
solve b = if length invalidList >= 1 then "NO" else "YES"
  where
    checkList   = map (filter $ within n) [[(x-1,y),(x+1,y),(x,y-1),(x,y+1)] | x <- [0..n-1], y <- [0..n-1]]
    countList   = map (cnt b) checkList
    invalidList = filter (\x -> (x `mod` 2) == 1) countList
    n           = length b

cnt :: [[Char]] -> [(Int,Int)] -> Int
cnt b [] = 0
cnt b ((x,y):lx) = c + (cnt b lx)
  where c = if ((b !! x) !! y) == 'o' then 1 else 0

within :: Int -> (Int, Int) -> Bool
within n (x, y) = (x >= 0) && (y >= 0) && (x <= n-1) && (y <= n-1)

import Control.Applicative
import Data.Array

main=do
	n<- read <$> getLine:: IO Int
	s<-    concat . lines<$>getContents
	let x = listArray ((1,1),(n,n)) s
	let y = array((1,1),(n,n)) [((i,j),m)| i<-[1..n],j<-[1..n],let m =length $ filter (=='o') $ map (x!)$filter (\z-> fst z >0 && fst z<=n && snd z >0 && snd z<=n) [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]]
	let z= length $ take 1 $ filter (odd) $ elems y
	putStrLn $ if z==1 then "NO" else "YES"

-- from submiession by qqz003 http://codeforces.com/contest/462/submission/7685448

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

main :: IO ()
main = LC.interact $ LC.pack . show . solve . map (map (\x -> if x=='o' then 1 else 0)) . tail . map LC.unpack . LC.words

solve :: [[Int]] -> String
solve a = if (all even f3) then "YES" else "NO"
          where
              f1 = map add a
              f2 = map add $ L.transpose a
              f3 = zipWith (+) (concat f1) (concat $ L.transpose f2)

add a = zipWith (+) (tail a ++ [0]) (0 : init a)

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

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

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

main = do
  n <- readLn
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, n)) $ concat a :: UArray (Int, Int) Char

    b = and [f i j | i <- [1..n], j <- [1..n]]
      where
        f i j = if a'!(i, j) == 'o' then True else even $ length [(ii, jj) | (ii, jj) <- [(i+1,j), (i-1,j), (i,j-1), (i,j+1)], 1 <= ii && ii <= n && 1 <= jj && jj <= n, a'!(ii, jj) == 'o']

  putStrLn $ if b then "YES" else "NO"

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Category           ((>>>))
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.HashMap.Lazy          as HM
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | symmetrical matrix = "YES"
    | otherwise = "NO"
    where symmetrical m = m == transpose m

--process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO [Char]
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings    #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = BString

type Matrix = [String]

solve :: Matrix -> Result
solve matrix
    | symmetrical matrix = "YES"
    | otherwise = "NO"
    where symmetrical m = m == transpose m

process :: State Reader Result
process = do
    n <- parse
    matrix <- replicateM n parse
    return $ solve matrix
--    return (matrix, transpose matrix)

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO String
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = takeWhile (/='\r') . B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

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

solve :: [String] -> Bool
solve (ns:cs) = all even [ length [ () | (di, dj) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
                                       , 0 <= i + di, i + di < n
                                       , 0 <= j + dj, j + dj < n
                                       , cs !! i !! j == 'o' ]
                                       | i <- [0..n-1], j <- [0..n-1] ]
  where n = read ns

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


You are given an array of positive integers $$$a_1, a_2, \ldots, a_n$$$.Make the product of all the numbers in the array (that is, $$$a_1 \cdot a_2 \cdot \ldots \cdot a_n$$$) divisible by $$$2^n$$$.You can perform the following operation as many times as you like:  select an arbitrary index $$$i$$$ ($$$1 \leq i \leq n$$$) and replace the value $$$a_i$$$ with $$$a_i=a_i \cdot i$$$. You cannot apply the operation repeatedly to a single index. In other words, all selected values of $$$i$$$ must be different.Find the smallest number of operations you need to perform to make the product of all the elements in the array divisible by $$$2^n$$$. Note that such a set of operations does not always exist.

The first line of the input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^4$$$) — the number test cases. Then the descriptions of the input data sets follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of array $$$a$$$. The second line of each test case contains exactly $$$n$$$ integers: $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$). It is guaranteed that the sum of $$$n$$$ values over all test cases in a test does not exceed $$$2 \cdot 10^5$$$.

For each test case, print the least number of operations to make the product of all numbers in the array divisible by $$$2^n$$$. If the answer does not exist, print -1.

NoteIn the first test case, the product of all elements is initially $$$2$$$, so no operations needed.In the second test case, the product of elements initially equals $$$6$$$. We can apply the operation for $$$i = 2$$$, and then $$$a_2$$$ becomes $$$2\cdot2=4$$$, and the product of numbers becomes $$$3\cdot4=12$$$, and this product of numbers is divided by $$$2^n=2^2=4$$$. In the fourth test case, even if we apply all possible operations, we still cannot make the product of numbers divisible by $$$2^n$$$  — it will be $$$(13\cdot1)\cdot(17\cdot2)\cdot(1\cdot3)\cdot(1\cdot4)=5304$$$, which does not divide by $$$2^n=2^4=16$$$.In the fifth test case, we can apply operations for $$$i = 2$$$ and $$$i = 4$$$.

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)

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

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse . sort . filter (/= 0) $ map twoFactors [1..length vs])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  B.getLine
  vs <- map readInt . B.words <$> B.getLine
  print $ solve vs

readInt :: B.ByteString -> Int
readInt = maybe 0 fst . B.readInt

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse . sort . filter (/= 0) $ map twoFactors [1..length vs])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  getLine
  vs <- map read . words <$> getLine
  print $ solve vs

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

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

{- solution -}

solve :: Int -> [Int] -> Maybe Int
solve n as = if finalCnt2 >= n
        then Just steps
        else Nothing
    where
        powers2 = L.iterate (*2) 2
        cntPowers2 x = L.length $ L.takeWhile (\md -> x `mod` md == 0) powers2

        cnt2 :: Int
        cnt2 = L.sum . L.map cntPowers2 $ as

        cnts2 :: [(Int, Int)]
        cnts2 = L.sortOn ((* (-1)) . snd) $ L.map (\i -> (i, cntPowers2 i)) [1..n]

        solve' :: ((), (Int, Int))
        solve' = flip MS.execStateT (0 :: Int, cnt2) $ do
            M.forM_ cnts2 $ \(i, iCnt2) ->
                M.runMaybeT $ do
                    (steps, cnt2) <- MS.get
                    M.guard $ cnt2 < n
                    M.guard $ iCnt2 > 0
                    MS.modify (\(steps, cnt2) -> (steps + 1, cnt2 + iCnt2))

        (_, (steps, finalCnt2)) = solve'

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = fromMaybe (-1) $ solve n as
        printf "%d\n" answer

module Main where

import Control.Monad (replicateM_)

intLogBase :: Int -> Int -> Int
intLogBase b v
  | v >= b    = 1 + intLogBase (2 * b) v
  | otherwise = 0

twoFactors :: Int -> Int
twoFactors v
  | even v    = 1 + twoFactors (v `div` 2)
  | otherwise = 0

solve :: [Int] -> Int
solve vs = case dropWhile (\(_, v) -> v < requiredTwoFactors) gainableTwoFactors of
              x:_ -> fst x
              _   -> -1
  where availableTwoFactors = sum $ map twoFactors vs
        requiredTwoFactors = max 0 $ length vs - availableTwoFactors
        gainableTwoFactors = [0..] `zip` scanl (+) 0 (reverse [1..intLogBase 2 (length vs)])
                              -- Pair of (i, v): with i steps a gain of v two factors is possible.

handleTestCase :: IO ()
handleTestCase = do
  getLine
  vs <- map read . words <$> getLine
  print $ solve vs

main :: IO ()
main = do
  numberTestCases <- read <$> getLine
  replicateM_ numberTestCases handleTestCase


You are given an array of n integer numbers. Let sum(l, r) be the sum of all numbers on positions from l to r non-inclusive (l-th element is counted, r-th element is not counted). For indices l and r holds 0 ≤ l ≤ r ≤ n. Indices in array are numbered from 0. For example, if a = [ - 5, 3, 9, 4], then sum(0, 1) =  - 5, sum(0, 2) =  - 2, sum(1, 4) = 16 and sum(i, i) = 0 for each i from 0 to 4.Choose the indices of three delimiters delim0, delim1, delim2 (0 ≤ delim0 ≤ delim1 ≤ delim2 ≤ n) and divide the array in such a way that the value of res = sum(0, delim0) - sum(delim0, delim1) + sum(delim1, delim2) - sum(delim2, n) is maximal. Note that some of the expressions sum(l, r) can correspond to empty segments (if l = r for some segment).

The first line contains one integer number n (1 ≤ n ≤ 5000). The second line contains n numbers a0, a1, ..., an - 1 ( - 109 ≤ ai ≤ 109).

Choose three indices so that the value of res is maximal. If there are multiple answers, print any of them.

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Data.List (maximumBy, intercalate)
import Data.Function (on)
import Data.Int (Int64)

readInt = fst . M.fromJust . C.readInt

run (x:xs) i d di md | nd > md = run xs (i + 1) nd i nd
                     | otherwise = run xs (i + 1) nd di md where nd = d + 2 * x
run [] _ _ di md = (md, di)

runx xs i = (mda + mdb, [dia, i, dib])
    where (xa, xb) = splitAt i xs
          (da, db) = (-sum xa, -sum xb)
          (mda, dia) = run xa 1 da 0 da
          (mdb, dib) = run xb (i + 1) db i db

main = do
    (readInt -> n) <- B.getLine
    (map (fromIntegral . readInt) . C.words -> xs :: [Int64]) <- B.getLine
    putStrLn . intercalate " " . map show . snd . maximumBy (compare `on` fst) . map (runx xs) $ [1..n]

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Data.List (maximumBy, intercalate)
import Data.Function (on)

readInt = fst . M.fromJust . C.readInt

run (x:xs) i d di md | nd > md = run xs (i + 1) nd i nd
                     | otherwise = run xs (i + 1) nd di md where nd = d + 2 * x
run [] _ _ di md = (md, di)

runx xs i = (mda + mdb, [dia, i, dib])
    where (xa, xb) = splitAt i xs
          (da, db) = (-sum xa, -sum xb)
          (mda, dia) = run xa 1 da 0 da
          (mdb, dib) = run xb (i + 1) db i db

main = do
    (readInt -> n) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn . intercalate " " . map show . snd . maximumBy (compare `on` fst) . map (runx xs) $ [1..n]


You have a knapsack with the capacity of $$$W$$$. There are also $$$n$$$ items, the $$$i$$$-th one has weight $$$w_i$$$. You want to put some of these items into the knapsack in such a way that their total weight $$$C$$$ is at least half of its size, but (obviously) does not exceed it. Formally, $$$C$$$ should satisfy: $$$\lceil \frac{W}{2}\rceil \le C \le W$$$. Output the list of items you will put into the knapsack or determine that fulfilling the conditions is impossible. If there are several possible lists of items satisfying the conditions, you can output any. Note that you don't have to maximize the sum of weights of items in the knapsack.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains integers $$$n$$$ and $$$W$$$ ($$$1 \le n \le 200\,000$$$, $$$1\le W \le 10^{18}$$$).  The second line of each test case contains $$$n$$$ integers $$$w_1, w_2, \dots, w_n$$$ ($$$1 \le w_i \le 10^9$$$) — weights of the items. The sum of $$$n$$$ over all test cases does not exceed $$$200\,000$$$.

For each test case, if there is no solution, print a single integer $$$-1$$$.  If there exists a solution consisting of $$$m$$$ items, print $$$m$$$ in the first line of the output and $$$m$$$ integers $$$j_1$$$, $$$j_2$$$, ..., $$$j_m$$$ ($$$1 \le j_i \le n$$$, all $$$j_i$$$ are distinct) in the second line of the output  — indices of the items you would like to pack into the knapsack. If there are several possible lists of items satisfying the conditions, you can output any. Note that you don't have to maximize the sum of weights items in the knapsack.

NoteIn the first test case, you can take the item of weight $$$3$$$ and fill the knapsack just right.In the second test case, all the items are larger than the knapsack's capacity. Therefore, the answer is $$$-1$$$.In the third test case, you fill the knapsack exactly in half.

import Data.List
import Data.Ord

solve :: Integer -> [Integer] -> Maybe [Integer]
solve w ws =
  let indexed = zip ws [1..]
      sorted = sortBy (comparing $ Down . fst) indexed
      dropped = dropWhile (\x -> fst x > w) sorted
  in solve' 0 [] dropped
     where solve' acc ans [] = Nothing
           solve' acc ans (x:xs) =
             if acc + next >= half w
               then Just $ ind : ans
               else solve' (acc + next) (ind : ans) xs
               where half x = ceiling (fromIntegral x / 2)
                     next = fst x
                     ind = snd x

solveCase :: IO ()
solveCase = do
  line <- getLine
  let n:w:[] = readInts line
  line <- getLine
  let ws = readInts line
  case solve w ws of Just ans -> do
                       print $ length ans
                       putStrLn $ intercalate " " (map show ans)
                     Nothing  -> putStrLn "-1"

readInts :: String -> [Integer]
readInts s = map read (words s)

repeatAction :: Int -> IO () -> IO ()
repeatAction 0 _ = return ()
repeatAction n action = do
  action
  repeatAction (n - 1) action

main :: IO ()
main = do
  line <- getLine
  let t = (read line :: Int)
  repeatAction t solveCase

import Data.List
import Data.Ord

solve :: Int -> [Int] -> Maybe [Int]
solve w ws =
  let indexed = zip ws [1..]
      sorted = sortBy (comparing $ Down . fst) indexed
      dropped = dropWhile (\x -> fst x > w) sorted
  in solve' 0 [] dropped
     where solve' acc ans [] = Nothing
           solve' acc ans (x:xs) =
             if acc + next >= half w
               then Just $ ind : ans
               else solve' (acc + next) (ind : ans) xs
               where half x = ceiling (fromIntegral x / 2)
                     next = fst x
                     ind = snd x

solveCase :: IO ()
solveCase = do
  line <- getLine
  let n:w:[] = readInts line
  line <- getLine
  let ws = readInts line
  case solve w ws of Just ans -> do
                       print $ length ans
                       putStrLn $ intercalate " " (map show ans)
                     Nothing  -> putStrLn "-1"

readInts :: String -> [Int]
readInts s = map read (words s)

repeatAction :: Int -> IO () -> IO ()
repeatAction 0 _ = return ()
repeatAction n action = do
  action
  repeatAction (n - 1) action

main :: IO ()
main = do
  line <- getLine
  let t = (read line :: Int)
  repeatAction t solveCase


A permutation p is an ordered group of numbers p1,   p2,   ...,   pn, consisting of n distinct positive integers, each is no more than n. We'll define number n as the length of permutation p1,   p2,   ...,   pn.Simon has a positive integer n and a non-negative integer k, such that 2k ≤ n. Help him find permutation a of length 2n, such that it meets this equation: .

The first line contains two integers n and k (1 ≤ n ≤ 50000, 0 ≤ 2k ≤ n).

Print 2n integers a1, a2, ..., a2n — the required permutation a. It is guaranteed that the solution exists. If there are multiple solutions, you can print any of them.

NoteRecord |x| represents the absolute value of number x. In the first sample |1 - 2| - |1 - 2| = 0.In the second sample |3 - 2| + |1 - 4| - |3 - 2 + 1 - 4| = 1 + 3 - 2 = 2.In the third sample |2 - 7| + |4 - 6| + |1 - 3| + |5 - 8| - |2 - 7 + 4 - 6 + 1 - 3 + 5 - 8| = 12 - 12 = 0.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
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.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

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

main = do
    [n,k] <- readLns :: IO [Int]
    putStrLn $ unwords $ map show $ [2*k,2*k-1..1]++[2*k+1..2*n]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
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.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

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

main = do
    [n,k] <- readLns :: IO [Int]
    putStrLn $ unwords $ map show $ [k,k-1..1]++[k+1..2*n]


One way to create a task is to learn from life. You can choose some experience in real life, formalize it and then you will get a new task.Let's think about a scene in real life: there are lots of people waiting in front of the elevator, each person wants to go to a certain floor. We can formalize it in the following way. We have n people standing on the first floor, the i-th person wants to go to the fi-th floor. Unfortunately, there is only one elevator and its capacity equal to k (that is at most k people can use it simultaneously). Initially the elevator is located on the first floor. The elevator needs |a - b| seconds to move from the a-th floor to the b-th floor (we don't count the time the people need to get on and off the elevator).What is the minimal number of seconds that is needed to transport all the people to the corresponding floors and then return the elevator to the first floor?

The first line contains two integers n and k (1 ≤ n, k ≤ 2000) — the number of people and the maximal capacity of the elevator. The next line contains n integers: f1, f2, ..., fn (2 ≤ fi ≤ 2000), where fi denotes the target floor of the i-th person.

Output a single integer — the minimal time needed to achieve the goal.

NoteIn first sample, an optimal solution is:   The elevator takes up person #1 and person #2.  It goes to the 2nd floor.  Both people go out of the elevator.  The elevator goes back to the 1st floor.  Then the elevator takes up person #3.  And it goes to the 2nd floor.  It picks up person #2.  Then it goes to the 3rd floor.  Person #2 goes out.  Then it goes to the 4th floor, where person #3 goes out.  The elevator goes back to the 1st floor.

import System.IO
import Data.List

main :: IO ()
main = do
	line1 <- getLine
	let k = head . tail . map read . words $ line1
	line2 <- getLine
	let nums = map read . words $ line2
	print . minTime k $ sortBy (flip compare) nums

minTime :: Integer -> [Integer] -> Integer
minTime _ [] = 0
minTime k xs = 2 * (maxFloor - 1) + minTime k rest
	where
		(batch, rest) = splitAt (fromIntegral k) xs
		maxFloor = head batch

-- Codeforces 472B

import Data.List

main :: IO ()
main = do
    [n, k] <- fmap (map read . words) getLine :: IO [Int]
    people <- fmap (reverse . sort . map read . words) getLine :: IO [Int]
    print $ solve k people where
        solve k people
            | length people == 0 = 0
            | length people <= k = 2 * (maximum people - 1)
            | otherwise = 2 * (head people - 1) + solve k (drop k people)

import Data.List (sortBy)

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

solve :: [[Int]] -> Int
solve [[_, k], fs] = (2*) $ sum [ f | (i, f) <- zip [0..] $ map (subtract 1) $ sortBy (flip compare) fs, i `mod` k == 0 ]
solve _ = undefined

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs
{-# INLINE slices #-}

main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  fs <- map readInt.B.words <$> B.getContents
  print $ solve k fs

solve :: Int -> [Int] -> Int
solve k fs = foldl' (\acc xs->2 * (maximum xs - 1) + acc) 0.slices k $ sortBy (flip compare) fs

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

solve k [] = 0
solve k (h : hs) = h * 2 + solve k (drop (k-1) hs)

main = do
  [n,k] <- getInts
  fs <- reverse . sort . map (subtract 1) <$> getInts
  let solution = [solve k fs]
  putStrLn $ unwords $ map show solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

import Data.List

answer :: Int -> [Int] -> Int
answer k xs = answer' k (reverse $ sort xs) where
  answer' k xs
    | (k >= l) = m
    | otherwise = m + answer' k (drop k xs) where
      l = length xs
      m = 2 * (head xs - 1)

main = do
    s <- getLine
    let (n:k:xs) = map read (words s)
    t <- getLine
    let ys = map read (words t)
    putStrLn (show (answer k ys))

import Data.List

main = interact $ show . sum.sl . map read . words
sl (n:k:f) = map ((!!) $ reverse.sort $ map (\x -> x*2-2) f) [0, k..n-1]

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

chunkmax _ [] = []
chunkmax n s = head s: ( chunkmax n (drop n s))

main= do
	[n,m] <-map read. words <$> getLine   ::IO [Int]
	s<-reverse.sort.map read. words <$> getLine   ::IO [Int]
	let s1 = chunkmax m s
	print $ 2*((sum s1) - (length s1))

import Data.List

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

solve :: [Int] -> Int
solve (n:k:f) =
    let sf = (sortBy (flip compare) f)
    in (solve' sf k) * 2
    where
        solve' :: [Int] -> Int -> Int
        solve' []     _ = 0
        solve' (f:fs) i | i == k    = f - 1 + (solve' fs 1)
                        | otherwise = solve' fs (i + 1)

{-# 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 = fromJust . fmap fst . B.readInt
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 . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,k) <- readIntPair
    fs <- readInts
    print $ solve n k fs

solve :: Int -> Int -> [Int] -> Int
solve n k fs' = go fs where
    fs = reverse $ sort $ map pred fs'
    go [] = 0
    go l = 2 * head l + go l' where
        l' = drop k l

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

solve k [] = 0
solve k (h : hs) = h * 2 + solve k (drop (k-1) hs)

main = do
  [n,k] <- getInts
  fs <- reverse . sort <$> getInts
  let solution = [solve k fs]
  putStrLn $ unwords $ map show solution

-- helper functions --

readInt = fst . fromJust . B.readInt
getInts = map readInt . B.words <$> B.getLine

memoArr :: Ix i => (i, i) -> (i -> r) -> (i -> r)
memoArr range f = f' where
  f' i
    | Arr.inRange range i = arr ! i
    | otherwise = f i
  arr = Arr.listArray range (map f (Arr.range range))

dpArr :: Ix i => (i, i) -> ((i -> r) -> (i -> r)) -> (i -> r)
dpArr ixs f = fix (memoArr ixs . f)

import Data.List

main = interact $ show . sol . map read . words

sol (_:k:f) =  (*2) . sum . ct . sort $ f
    where ct [] = []
          ct x = head x - 1 : (ct $ drop k x)


The game of Berland poker is played with a deck of $$$n$$$ cards, $$$m$$$ of which are jokers. $$$k$$$ players play this game ($$$n$$$ is divisible by $$$k$$$).At the beginning of the game, each player takes $$$\frac{n}{k}$$$ cards from the deck (so each card is taken by exactly one player). The player who has the maximum number of jokers is the winner, and he gets the number of points equal to $$$x - y$$$, where $$$x$$$ is the number of jokers in the winner's hand, and $$$y$$$ is the maximum number of jokers among all other players. If there are two or more players with maximum number of jokers, all of them are winners and they get $$$0$$$ points.Here are some examples:  $$$n = 8$$$, $$$m = 3$$$, $$$k = 2$$$. If one player gets $$$3$$$ jokers and $$$1$$$ plain card, and another player gets $$$0$$$ jokers and $$$4$$$ plain cards, then the first player is the winner and gets $$$3 - 0 = 3$$$ points;  $$$n = 4$$$, $$$m = 2$$$, $$$k = 4$$$. Two players get plain cards, and the other two players get jokers, so both of them are winners and get $$$0$$$ points;  $$$n = 9$$$, $$$m = 6$$$, $$$k = 3$$$. If the first player gets $$$3$$$ jokers, the second player gets $$$1$$$ joker and $$$2$$$ plain cards, and the third player gets $$$2$$$ jokers and $$$1$$$ plain card, then the first player is the winner, and he gets $$$3 - 2 = 1$$$ point;  $$$n = 42$$$, $$$m = 0$$$, $$$k = 7$$$. Since there are no jokers, everyone gets $$$0$$$ jokers, everyone is a winner, and everyone gets $$$0$$$ points. Given $$$n$$$, $$$m$$$ and $$$k$$$, calculate the maximum number of points a player can get for winning the game.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Then the test cases follow. Each test case contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$2 \le n \le 50$$$, $$$0 \le m \le n$$$, $$$2 \le k \le n$$$, $$$k$$$ is a divisors of $$$n$$$).

For each test case, print one integer — the maximum number of points a player can get for winning the game.

NoteTest cases of the example are described in the statement.

import Control.Monad

type Test = (Integer, Integer, Integer)

getLines :: Int -> IO [Test]
getLines n = replicateM n getTest

getTest :: IO Test
getTest = do
    test <- getLine
    let [n, m, k] = map read (words test)
    return (n, m, k)

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = solve first : getAnswer rest

solve :: Test -> Integer
solve (n, m, k) = maxJokers - nextMaxJokers
    where maxJokers = min (n `div` k) m
          a = fromIntegral (m - maxJokers)
          b = fromIntegral (k - 1)
          nextMaxJokers = ceiling (a/b)

main :: IO ()
main = do
    count <- getLine
    tests <- getLines $ read count
    mapM_ print (getAnswer tests)

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:k:_) <- map read . words <$> getLine
    let d = n `div` k
    print $ bool (d - (m - d - 1) `div` (k - 1) - 1) m (m <= d)

module Main where

solve :: Int -> Int -> Int -> Int
solve cards jokers players =
  let hand     = cards `div` players
      -- Split the remaining jokers among the other players
      maxrival = q + min 1 r
          where (q, r) = (jokers - hand) `quotRem` (players - 1)
  in  if jokers <= hand then jokers else hand - maxrival

readCase :: Int -> IO ()
readCase 0       = return ()
readCase casenum = do
  l <- getLine
  let [n, m, k] = (map read . words) l :: [Int]
  print $ solve n m k
  readCase (casenum - 1)

main = getLine >>= (readCase . (read :: String -> Int))

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

parse :: String -> (Int, Int, Int)
parse s = (n, m, k)
  where
    [n, m, k] = map read . words $ s

solve :: (Int, Int, Int) -> Int
solve (n, m, k) = x - y
  where
    x = min (div n k) m
    y = div (m - x + k - 2) (k - 1)

module Main where
    solve :: IO ()
    solve = do
        s <- getLine
        let [n, m, k] = map (\x -> read x :: Integer) $ words s
            x = min m (n `div` k)
        putStrLn $ show $ x - (m - x + k - 2) `div` (k - 1)

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

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

solve :: [[Int]] -> [Int]
solve [] = []
solve ([n,m,k]:xs) = (count n m k ) : (solve xs)

count :: Int -> Int -> Int -> Int
count n m k = winnerJ - secondJ
	where
		card = n `div` k
		winnerJ = min m card
		secondJ = (m - winnerJ + k - 2) `div` (k-1)

main = do
	t' <- getLine
	let t = read t' :: Int
	input' <- getContents
	let input = map (map read) (take t (map words (lines input'))) :: [[Int]]
	let result = solve input
	mapM print result

import Data.List

-- import Debug.Trace

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let (_:vals) = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []          -> Nothing
          n:m:k:rest  ->
            let handSize = n `div` k
                winner = min handSize m
                bestLoser = (m - winner + k - 2) `div` (k - 1)
                subres = winner - bestLoser
            in Just (subres, rest)
        ) vals
  sequence_ (putStrLn . show <$> res)

solve :: (Int, Int, Int) -> Int
solve (n, m, k) = let  sz = div n k  in  case  ()  of
  () | sz >= m   -> m  -- all jokers in one hand
     | otherwise -> case  divMod (m - sz) (k-1)  of
       (excess, 0) -> sz - excess  -- distribute evenly
       (excess, _) -> sz - excess - 1

parse :: String -> [(Int, Int, Int)]
parse inp = [(n, m, k) | [n, m, k] <- map (map read . words) (tail $ lines inp)]

main :: IO ()
main = interact (unlines . map (show . solve) . parse)


Tanya has $$$n$$$ candies numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th candy has the weight $$$a_i$$$.She plans to eat exactly $$$n-1$$$ candies and give the remaining candy to her dad. Tanya eats candies in order of increasing their numbers, exactly one candy per day.Your task is to find the number of such candies $$$i$$$ (let's call these candies good) that if dad gets the $$$i$$$-th candy then the sum of weights of candies Tanya eats in even days will be equal to the sum of weights of candies Tanya eats in odd days. Note that at first, she will give the candy, after it she will eat the remaining candies one by one.For example, $$$n=4$$$ and weights are $$$[1, 4, 3, 3]$$$. Consider all possible cases to give a candy to dad:  Tanya gives the $$$1$$$-st candy to dad ($$$a_1=1$$$), the remaining candies are $$$[4, 3, 3]$$$. She will eat $$$a_2=4$$$ in the first day, $$$a_3=3$$$ in the second day, $$$a_4=3$$$ in the third day. So in odd days she will eat $$$4+3=7$$$ and in even days she will eat $$$3$$$. Since $$$7 \ne 3$$$ this case shouldn't be counted to the answer (this candy isn't good).  Tanya gives the $$$2$$$-nd candy to dad ($$$a_2=4$$$), the remaining candies are $$$[1, 3, 3]$$$. She will eat $$$a_1=1$$$ in the first day, $$$a_3=3$$$ in the second day, $$$a_4=3$$$ in the third day. So in odd days she will eat $$$1+3=4$$$ and in even days she will eat $$$3$$$. Since $$$4 \ne 3$$$ this case shouldn't be counted to the answer (this candy isn't good).  Tanya gives the $$$3$$$-rd candy to dad ($$$a_3=3$$$), the remaining candies are $$$[1, 4, 3]$$$. She will eat $$$a_1=1$$$ in the first day, $$$a_2=4$$$ in the second day, $$$a_4=3$$$ in the third day. So in odd days she will eat $$$1+3=4$$$ and in even days she will eat $$$4$$$. Since $$$4 = 4$$$ this case should be counted to the answer (this candy is good).  Tanya gives the $$$4$$$-th candy to dad ($$$a_4=3$$$), the remaining candies are $$$[1, 4, 3]$$$. She will eat $$$a_1=1$$$ in the first day, $$$a_2=4$$$ in the second day, $$$a_3=3$$$ in the third day. So in odd days she will eat $$$1+3=4$$$ and in even days she will eat $$$4$$$. Since $$$4 = 4$$$ this case should be counted to the answer (this candy is good). In total there $$$2$$$ cases which should counted (these candies are good), so the answer is $$$2$$$.

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

Print one integer — the number of such candies $$$i$$$ (good candies) that if dad gets the $$$i$$$-th candy then the sum of weights of candies Tanya eats in even days will be equal to the sum of weights of candies Tanya eats in odd days.

NoteIn the first example indices of good candies are $$$[1, 2]$$$.In the second example indices of good candies are $$$[2, 3]$$$.In the third example indices of good candies are $$$[4, 5, 9]$$$.

import Data.List(scanl')

proc :: [Int] -> Int -> [Int]
proc [a] x = []
proc (a:b:c) x = (a+b-x):(proc (b:c) x)

ft' :: Int -> [a] -> (Int -> Bool) -> a -> [a]
ft' _ [] _ _ = []
ft' i (a:b) f x = (if (f i) then a else x) : (ft' (succ i) b f x)

ft = ft' 0

getsame :: [Int] -> [Int] -> Int
getsame [] _ = 0
getsame _ [] = 0
getsame (a:b) (c:d) = (if a == c then 1 else 0)+getsame b d
main = do
    nstr <- getLine
    let n = (read::String->Int) nstr
    str <- getLine
    let a = map (read::String->Int) $ words str
    let to = length a - 1
    let odds  = scanl' (+) 0 $ ft a odd 0
    let evens = scanl' (+) 0 $ ft a even 0
    print $ getsame (proc odds $ last odds) (proc evens $ last evens)

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

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

main = interact solve

solve input =
    let n:xs = map fastRead . words $ input
        numbers = xs
        numbersA :: A.Array Int64 Int64
        numbersA = A.listArray (0, n-1) numbers
        reversed = reverse numbers

        dp :: A.Array (Int, Int64, Int64) Int64
        dp = A.array ((-1, 0, -1), (1, 1, n)) [((dir, pol, i), calcSum dir pol i) | dir <- [-1, 1], pol <- [0, 1], i <- [-1..n]]
        calcSum :: Int -> Int64 -> Int64 -> Int64
        calcSum 1 polarity i
            | i >= n = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(1, polarity, i + 1)
            | otherwise = dp!(1, polarity, i + 1)
        calcSum (-1) polarity i
            | i < 0 = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(-1, polarity, i - 1)
            | otherwise = dp!(-1, polarity, i - 1)

        isOkAt i =
            let totalP1 = toLeft + toRight2
                totalP2 = toLeft2 + toRight
                toRight = calcSum 1 polarity i+1
                toRight2 = calcSum 1 ipolarity i+1
                toLeft = calcSum (-1) polarity i-1
                toLeft2 = calcSum (-1) ipolarity i-1
                polarity = i `mod` 2
                ipolarity = 1 - polarity
            in totalP1 == totalP2
    in show . length $ filter isOkAt [0..(n-1)]
    -- in show $ calcSum 1 1 0

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

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

main = interact solve

solve input =
    let n:xs = map fastRead . words $ input
        numbers = xs
        numbersA :: A.Array Int64 Int64
        numbersA = A.listArray (0, n-1) numbers
        reversed = reverse numbers

        dp :: A.Array (Int, Int64, Int64) Int64
        dp = A.array ((-1, 0, -1), (1, 1, n)) (do {
            dir <- [-1, 1];
            pol <- [0, 1];
            i <- [-1..n];
            return ((dir, pol, i), calcSum dir pol i);
        })

        calcSum :: Int -> Int64 -> Int64 -> Int64
        calcSum 1 polarity i
            | i >= n = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(1, polarity, i + 1)
            | otherwise = dp!(1, polarity, i + 1)
        calcSum (-1) polarity i
            | i < 0 = 0
            | i `mod` 2 == polarity = numbersA!i + dp!(-1, polarity, i - 1)
            | otherwise = dp!(-1, polarity, i - 1)

        isOkAt i =
            let totalP1 = toLeft + toRight2
                totalP2 = toLeft2 + toRight
                toRight = calcSum 1 polarity i+1
                toRight2 = calcSum 1 ipolarity i+1
                toLeft = calcSum (-1) polarity i-1
                toLeft2 = calcSum (-1) ipolarity i-1
                polarity = i `mod` 2
                ipolarity = 1 - polarity
            in totalP1 == totalP2
    in show . length $ filter isOkAt [0..(n-1)]
    -- in show $ calcSum 1 1 0

import Data.List
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe

sumEvens [] = 0
sumEvens [x] = x
sumEvens (x:y:xs) = (+x) $ sumEvens xs

testCandyEven [] _ _ _ _ = 0
testCandyEven (x:xs) esf osf eall oall = (+rez) $ testCandyOdd xs (esf + x) osf erest oall
  where erest = eall - x
        rez = if (erest + osf) == (oall + esf) then 1 else 0

testCandyOdd [] _ _ _ _ = 0
testCandyOdd (x:xs) esf osf eall oall = (+rez) $ testCandyEven xs esf (osf + x) eall orest
  where orest = oall - x
        rez = if (eall + osf) == (orest + esf) then 1 else 0

main=do
 n <- readLn::IO Int
 v <- map (fst . fromJust . B.readInt).B.words <$> B.getLine
 let se = sumEvens v
 let sodd = (sum v) - se
 print $ testCandyEven v 0 0 se sodd

import Data.List
import Control.Monad

sumEvens [] = 0
sumEvens [x] = x
sumEvens (x:y:xs) = (+x) $ sumEvens xs

testCandyEven [] _ _ _ _ = 0
testCandyEven (x:xs) esf osf eall oall = (+rez) $ testCandyOdd xs (esf + x) osf erest oall
  where erest = eall - x
        rez = if (erest + osf) == (oall + esf) then 1 else 0

testCandyOdd [] _ _ _ _ = 0
testCandyOdd (x:xs) esf osf eall oall = (+rez) $ testCandyEven xs esf (osf + x) eall orest
  where orest = oall - x
        rez = if (eall + osf) == (orest + esf) then 1 else 0

main=do
 n <- readLn::IO Int
 v <- map (read::String->Int).words <$> getLine
 let se = sumEvens v
 let sodd = (sum v) - se
 print $ testCandyEven v 0 0 se sodd


You are given a set of $$$n$$$ ($$$n$$$ is always a power of $$$2$$$) elements containing all integers $$$0, 1, 2, \ldots, n-1$$$ exactly once.Find $$$\frac{n}{2}$$$ pairs of elements such that:  Each element in the set is in exactly one pair.  The sum over all pairs of the bitwise AND of its elements must be exactly equal to $$$k$$$. Formally, if $$$a_i$$$ and $$$b_i$$$ are the elements of the $$$i$$$-th pair, then the following must hold: $$$$$$\sum_{i=1}^{n/2}{a_i \& b_i} = k,$$$$$$ where $$$\&$$$ denotes the bitwise AND operation. If there are many solutions, print any of them, if there is no solution, print $$$-1$$$ instead.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 400$$$) — the number of test cases. Description of the test cases follows. Each test case consists of a single line with two integers $$$n$$$ and $$$k$$$ ($$$4 \leq n \leq 2^{16}$$$, $$$n$$$ is a power of $$$2$$$, $$$0 \leq k \leq n-1$$$). The sum of $$$n$$$ over all test cases does not exceed $$$2^{16}$$$. All test cases in each individual input will be pairwise different.

For each test case, if there is no solution, print a single line with the integer $$$-1$$$. Otherwise, print $$$\frac{n}{2}$$$ lines, the $$$i$$$-th of them must contain $$$a_i$$$ and $$$b_i$$$, the elements in the $$$i$$$-th pair.  If there are many solutions, print any of them. Print the pairs and the elements in the pairs in any order.

NoteIn the first test, $$$(0\&3)+(1\&2) = 0$$$.In the second test, $$$(0\&2)+(1\&3) = 1$$$.In the third test, $$$(0\&1)+(2\&3) = 2$$$.In the fourth test, there is no solution.

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.Bits
import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    let
      nc2 = n * (n - 1) `div` 2
      tarXorTotal = nc2 - 2 * k

      numPairs = n `div` 2
      canSolve = inRange (numPairs, numPairs * (n - 1)) tarXorTotal

      tryWith baselineXor = let
        lastPairsXor = (tarXorTotal - baselineXor * (numPairs - 2)) `div` 2

        basicArr = array (0, n-1) [(i, i `xor` baselineXor) | i <- [0 .. n-1]]
        toLi :: UArray Int Int -> [[Int]]
        toLi arr = [[i, j] | (i, j) <- assocs arr, i < j]
        in  if  inRange (1, n - 1) lastPairsXor
        then  Just $ if  baselineXor == lastPairsXor
          then  toLi basicArr
          else  toLi $ basicArr //
            [ (0, lastPairsXor)
            , (lastPairsXor, 0)
            , (baselineXor, baselineXor `xor` lastPairsXor)
            , (baselineXor `xor` lastPairsXor, baselineXor)
            ]
        else  Nothing

      ans = if  canSolve
        then  head $ mapMaybe tryWith [1 .. n - 1]
        else  [[-1]]
    pure $ foldMap putInts ans

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    let
      basicArr = listArray (0, n-1) [n-1, n-2 .. 0]
      directArr x = basicArr // [(x, n-1), (n-1, x), (0, n-1-x), (n-1-x, 0)]
      s = div n 2
      maxArr = directArr (k-1) // [(s+1, s-1), (s-1, s+1), (s-2, s), (s, s-2)]
      toLi :: UArray Int Int -> [[Int]]
      toLi arr = [[i, j] | (i, j) <- assocs arr, i < j]
      ans = if  n == 4 && k == 3
        then  [[-1]]
        else  if  k < n - 1
        then  toLi $ directArr k
        else  toLi maxArr
    pure $ foldMap putInts ans

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


Vanya decided to walk in the field of size n × n cells. The field contains m apple trees, the i-th apple tree is at the cell with coordinates (xi, yi). Vanya moves towards vector (dx, dy). That means that if Vanya is now at the cell (x, y), then in a second he will be at cell . The following condition is satisfied for the vector: , where  is the largest integer that divides both a and b. Vanya ends his path when he reaches the square he has already visited. Vanya wonders, from what square of the field he should start his path to see as many apple trees as possible.

The first line contains integers n, m, dx, dy(1 ≤ n ≤ 106, 1 ≤ m ≤ 105, 1 ≤ dx, dy ≤ n) — the size of the field, the number of apple trees and the vector of Vanya's movement. Next m lines contain integers xi, yi (0 ≤ xi, yi ≤ n - 1) — the coordinates of apples. One cell may contain multiple apple trees.

Print two space-separated numbers — the coordinates of the cell from which you should start your path. If there are several answers you are allowed to print any of them.

NoteIn the first sample Vanya's path will look like: (1, 3) - (3, 1) - (0, 4) - (2, 2) - (4, 0) - (1, 3)In the second sample: (0, 0) - (1, 1) - (0, 0)

import Data.List
import Data.Int
main = interact $ unwords . f . map (read :: String -> Int64) . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (mod (m * x) n * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (m * x * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (mod (m * x) n * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (n + cy - steps ! cx) `rem` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `rem` n, (y + dy) `mod` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (n + cy - steps ! cx) `rem` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `rem` n, (y + dy) `rem` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (cy - steps ! cx) `mod` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `mod` n, (y + dy) `mod` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import qualified Data.Map as M
import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = M.fromList $ map (\x -> (mod (x * (n - dx)) n, x)) [0..n-1]
  i x y = mod (y + dy * M.findWithDefault 0 x m) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h :: [Int] -> [Int]
  h [] = []
  h (x:y:s) = i x y:h s

import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (m * x * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s


Petya loves lucky numbers. We all know that lucky numbers are the positive integers whose decimal representations contain only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya got an array consisting of n numbers, it is the gift for his birthday. Now he wants to sort it in the non-decreasing order. However, a usual sorting is boring to perform, that's why Petya invented the following limitation: one can swap any two numbers but only if at least one of them is lucky. Your task is to sort the array according to the specified limitation. Find any possible sequence of the swaps (the number of operations in the sequence should not exceed 2n).

The first line contains an integer n (1 ≤ n ≤ 105) — the number of elements in the array. The second line contains n positive integers, not exceeding 109 — the array that needs to be sorted in the non-decreasing order.

On the first line print number k (0 ≤ k ≤ 2n) — the number of the swaps in the sorting. On the following k lines print one pair of distinct numbers (a pair per line) — the indexes of elements to swap. The numbers in the array are numbered starting from 1. If it is impossible to sort the given sequence, print the single number -1. If there are several solutions, output any. Note that you don't have to minimize k. Any sorting with no more than 2n swaps is accepted.

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

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

import Control.Monad.ST
import Data.Array.ST

import Debug.Trace

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

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

is47 n | n < 10                = n == 4 || n == 7
       | elem lastDigit [4, 7] = is47 n'
       | otherwise             = False
  where
    (n', lastDigit) = n `divMod` 10

isSorted xs = and $ zipWith (<=) xs (tail xs)

solve (n, a)
    | null pos47 = BS.pack $ if isSorted a then "0" else "-1"
    | otherwise  = BS.unlines (BS.pack (show $ length answer) : [ BS.pack $ show a ++ " " ++ show b | (a, b) <- answer])
  where
    arr = listArray (1, n) a :: UArray Int Int
    s = sort $ zip a [1..]
    from = listArray (1, n) (map snd s) :: UArray Int Int

    pos47 = [i | (i, ai) <- zip [1..] a, is47 ai]

    decompress = runST $ do
        vis <- newArray (1, n) False :: ST s (STUArray s Int Bool)
        filter (not.null) <$> mapM (dfs vis []) [1..n]
      where
        dfs :: STUArray s Int Bool -> [Int] -> Int -> ST s [Int]
        dfs vis lst p = do
            vp <- readArray vis p
            if vp
              then return lst
              else do
                writeArray vis p True
                dfs vis (p : lst) (from ! p)

    target = head pos47

    dep = b ++ a
      where
        (a, b) = partition (elem target) decompress

    walkCycle cycle = reverse (zip (last cycle : init cycle) cycle)

    solveCase [] = []
    solveCase [x] = []
    solveCase cycle | elem target cycle = init (walkCycle cycle')
      where
        pos = fromJust $ elemIndex target cycle
        cycle' = drop (pos + 1) cycle ++ take (pos + 1) cycle
    solveCase cycle = [(target, last cycle)] ++ init (walkCycle cycle) ++ [(target, head cycle)]

    answer = concatMap solveCase dep

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State


You are given a directed graph consisting of $$$n$$$ vertices. Each directed edge (or arc) labeled with a single character. Initially, the graph is empty.You should process $$$m$$$ queries with it. Each query is one of three types:   "$$$+$$$ $$$u$$$ $$$v$$$ $$$c$$$" — add arc from $$$u$$$ to $$$v$$$ with label $$$c$$$. It's guaranteed that there is no arc $$$(u, v)$$$ in the graph at this moment;  "$$$-$$$ $$$u$$$ $$$v$$$" — erase arc from $$$u$$$ to $$$v$$$. It's guaranteed that the graph contains arc $$$(u, v)$$$ at this moment;  "$$$?$$$ $$$k$$$" — find the sequence of $$$k$$$ vertices $$$v_1, v_2, \dots, v_k$$$ such that there exist both routes $$$v_1 \to v_2 \to \dots \to v_k$$$ and $$$v_k \to v_{k - 1} \to \dots \to v_1$$$ and if you write down characters along both routes you'll get the same string. You can visit the same vertices any number of times.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 2 \cdot 10^5$$$; $$$1 \le m \le 2 \cdot 10^5$$$) — the number of vertices in the graph and the number of queries. The next $$$m$$$ lines contain queries — one per line. Each query is one of three types:    "$$$+$$$ $$$u$$$ $$$v$$$ $$$c$$$" ($$$1 \le u, v \le n$$$; $$$u \neq v$$$; $$$c$$$ is a lowercase Latin letter);  "$$$-$$$ $$$u$$$ $$$v$$$" ($$$1 \le u, v \le n$$$; $$$u \neq v$$$);  "$$$?$$$ $$$k$$$" ($$$2 \le k \le 10^5$$$).  It's guaranteed that you don't add multiple edges and erase only existing edges. Also, there is at least one query of the third type.

For each query of the third type, print YES if there exist the sequence $$$v_1, v_2, \dots, v_k$$$ described above, or NO otherwise.

NoteIn the first query of the third type $$$k = 3$$$, we can, for example, choose a sequence $$$[1, 2, 3]$$$, since $$$1 \xrightarrow{\text{a}} 2 \xrightarrow{\text{b}} 3$$$ and $$$3 \xrightarrow{\text{a}} 2 \xrightarrow{\text{b}} 1$$$.In the second query of the third type $$$k = 2$$$, and we can't find sequence $$$p_1, p_2$$$ such that arcs $$$(p_1, p_2)$$$ and $$$(p_2, p_1)$$$ have the same characters.In the third query of the third type, we can, for example, choose a sequence $$$[1, 2, 3, 2, 1]$$$, where $$$1 \xrightarrow{\text{a}} 2 \xrightarrow{\text{b}} 3 \xrightarrow{\text{d}} 2 \xrightarrow{\text{c}} 1$$$.

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M

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

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

type State = (M.Map (Int, Int) Char, Int, Int)

addArc :: (Int, Int) -> Char -> State -> State
addArc (u, v) ch (mp, c1, c2)
  | isNothing rev = (mp', c1, c2)
  | fromJust rev == ch = (mp', c1 + 1, c2)
  | otherwise = (mp', c1, c2 + 1)
  where
  rev = M.lookup (v, u) mp
  mp' = M.insert (u, v) ch mp

delArc :: (Int, Int) -> State -> State
delArc (u, v) (mp, c1, c2)
  | isNothing rev = (mp', c1, c2)
  | fromJust rev == ch = (mp', c1 - 1, c2)
  | otherwise = (mp', c1, c2 - 1)
  where
  Just ch = M.lookup (u, v) mp
  rev = M.lookup (v, u) mp
  mp' = M.delete (u, v) mp

check :: State -> Int -> Bool
check (_, c1, c2) k
  | even k = c1 > 0
  | otherwise = c2 > 0 || c1 > 0

main :: IO ()
main = do
  [_, m] <- getInts
  ws <- replicateM m (fmap C.words C.getLine)
  let
    acc (st, rs) (s : ss) =
      case C.unpack s of
        "+" -> (addArc (u, v) ch st, rs)
        "-" -> (delArc (u, v) st, rs)
        "?" -> (st, check st (parseInt (head ss)) : rs)
      where
      (s1 : r1) = ss
      u = parseInt s1
      (s2 : r2) = r1
      v = parseInt s2
      (s3 : _) = r2
      ch = head $ C.unpack s3
    (_, results) = foldl' acc ((M.empty, 0, 0), []) ws
  mapM_ (\ok -> C.putStrLn $ C.pack $ if ok then "YES" else "NO") $ reverse results

{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P

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

import Data.Array.Unboxed
import Data.Array.IO.Safe

stableBucketSortOn :: forall t. (t -> Int) -> (Int, Int) -> [t] -> [t]
stableBucketSortOn fun bnds li = let
  buckets :: Array Int ([t] -> [t])
  buckets = accumArray (\f v -> f . (v :)) id bnds [(fun v, v) | v <- li]
  in  foldr ($) [] $ elems buckets

dedup :: Int -> [(Int, Int)] -> Array Int (Int, Int)
dedup n li = let
  ili = stableBucketSortOn snd (1, n) li
  sli = group $ stableBucketSortOn fst (1, n) ili
  in  listArray (1, length sli) $ map head sli

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

getIx :: Ord t => t -> Array Int t -> Int
getIx v arr = let
  (li, ri) = bounds arr
  in  binSearch (\ix -> v <= arr ! ix) li (ri + 1)

data Query
  = Ins Int Int Char
  | Rem Int Int
  | Ask Int

ui :: P.ByteString -> Int
ui = P.foldl' (\acc c -> 10 * acc + fromEnum c - fromEnum '0') 0

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  queries <- replicateM m $ do
    ask <- readLine
    pure $ case  P.words ask  of
      [_, u, v, c] -> Ins (ui u) (ui v) (P.head c)
      [_, u, v] -> Rem (ui u) (ui v)
      [_, k] -> Ask (ui k)
      _ -> error "invalid input"
  let
    usedPairs = dedup n [(min u v, max u v) | Ins u v _ <- queries]
    getArr = lift $ newArray (bounds usedPairs) '\0' :: SIO (IOUArray Int Char)
  ayes <- getArr
  nays <- getArr
  let
    step :: (Int, Int) -> Query -> SIO (Int, Int)
    step (!eq, !ok) (Ins u v c) = let
      (fwd, rev, ix) = if  u < v
        then  (ayes, nays, getIx (u, v) usedPairs)
        else  (nays, ayes, getIx (v, u) usedPairs)
      in  lift $ do
      writeArray fwd ix c
      cr <- readArray rev ix
      pure (eq + if  c == cr  then  1  else  0,
            ok + if  cr /= '\0' then  1  else  0)
    step (!eq, !ok) (Rem u v) = let
      (fwd, rev, ix) = if  u < v
        then  (ayes, nays, getIx (u, v) usedPairs)
        else  (nays, ayes, getIx (v, u) usedPairs)
      in  lift $ do
      c <- readArray fwd ix
      cr <- readArray rev ix
      writeArray fwd ix '\0'
      pure (eq - if  c == cr  then  1  else  0,
            ok - if  cr /= '\0' then  1  else  0)
    step v@(!eq, !ok) (Ask k) = (v <$) $ lift $ P.putStrLn $ P.pack
      $ if  eq > 0 || odd k && ok > 0
        then  "YES"
        else  "NO"
  foldM_ step (0, 0) queries

type SIO = StateT P.ByteString IO

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

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


Recently a dog was bought for Polycarp. The dog's name is Cormen. Now Polycarp has a lot of troubles. For example, Cormen likes going for a walk. Empirically Polycarp learned that the dog needs at least k walks for any two consecutive days in order to feel good. For example, if k = 5 and yesterday Polycarp went for a walk with Cormen 2 times, today he has to go for a walk at least 3 times. Polycarp analysed all his affairs over the next n days and made a sequence of n integers a1, a2, ..., an, where ai is the number of times Polycarp will walk with the dog on the i-th day while doing all his affairs (for example, he has to go to a shop, throw out the trash, etc.).Help Polycarp determine the minimum number of walks he needs to do additionaly in the next n days so that Cormen will feel good during all the n days. You can assume that on the day before the first day and on the day after the n-th day Polycarp will go for a walk with Cormen exactly k times. Write a program that will find the minumum number of additional walks and the appropriate schedule — the sequence of integers b1, b2, ..., bn (bi ≥ ai), where bi means the total number of walks with the dog on the i-th day.

The first line contains two integers n and k (1 ≤ n, k ≤ 500) — the number of days and the minimum number of walks with Cormen for any two consecutive days.  The second line contains integers a1, a2, ..., an (0 ≤ ai ≤ 500) — the number of walks with Cormen on the i-th day which Polycarp has already planned.

In the first line print the smallest number of additional walks that Polycarp should do during the next n days so that Cormen will feel good during all days.  In the second line print n integers b1, b2, ..., bn, where bi — the total number of walks on the i-th day according to the found solutions (ai ≤ bi for all i from 1 to n). If there are multiple solutions, print any of them.

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

solve :: [Int] -> (Int, [Int])
solve (n:k:a) = solve' (head a) (tail a) 0 [head a]
                where solve' :: Int -> [Int] -> Int -> [Int] -> (Int, [Int])
                      solve' last [] cost path = (cost, reverse path)
                      solve' last (a:x) cost path = let extra = max 0 (k - a - last)
                                                        walk = a + extra
                                                    in solve' walk x (cost + extra) (walk : path)

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

pp = putStrLn

dostuff lst kk uu sum
  | (null lst) = ( (reverse uu), sum )
  | (diff > 0) = dostuff (tail lst) kk ((diff + (head lst)) : uu) (diff + sum)
  | otherwise = dostuff (tail lst) kk ((head lst) : uu) (sum)
  where diff = (kk - ((head uu) + (head lst)))

makestr lst uu
  | (null lst) = (reverse uu)
  | otherwise = makestr (tail lst) (" " ++ (reverse (show (head lst))) ++ uu)

main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      k = (read (last (words ff)))::Int

  gg <- getLine
  let hh = conv (words gg) []

      ans = dostuff (tail hh) k [(head hh)] 0
--      anstwo = dostuff (tail (reverse hh)) k [(head (reverse hh))] 0

  pp (show (snd ans))
  pp (makestr (fst ans) [])
  -- pp "-------------------------------"

  -- pp (show (snd anstwo))
  -- pp (makestr (fst anstwo) [])

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ unlines.solve.tail.concat. map (map read.words).take 2. lines
solve :: [Integer]-> [String]
solve (x1:x2:[])=   map (unwords.(map show)) [[0], [x2]]
solve (x:y:xs) = map (unwords.(map show))  [[maximum [sum ff - sum (y:xs),0]],ff] where
  ff=scanl f y xs
  f b a = maximum [x-b,a]

import Control.Monad
import Data.List

walk _ acc [] = reverse acc
walk k (a:as) (b:bs) =
  walk k ((if a+b<k then k-a else b):a:as) bs

main = do
 [n,k] <- liftM (map (\x -> read x ::Integer) . words) getLine
 bs <- liftM (map (\x -> read x ::Integer) . words) getLine
 let c = walk k [head bs] $ tail bs
 print $ sum c - sum bs
 putStrLn $ concat $ intersperse " " $ map show  c

import Data.Functor

solve :: Int -> Int -> [Int] -> [Int]
solve _ _ []    = []
solve k l [a]   = [max a (k - l)]
solve k l (h:t) = let h' = max h (k - l) in h' : solve k h' t

main :: IO()
main = do
    [_, r] <- map read . words <$> getLine
    a      <- map read . words <$> getLine
    let b = solve r r a
    print $ sum b - sum a
    putStrLn . unwords . map show $ b

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let (_:bs) = scanl process k as
      process yesterday today | today + yesterday < k = k - yesterday
                              | otherwise             = today
  print $ sum $ zipWith (-) bs as
  putStrLn $ unwords $ map show bs

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let (_,bs) = mapAccumL process k as
      process yesterday today
        | avg < k = (today + k - avg,today + k - avg)
        | otherwise = (today,today)
        where avg = today + yesterday
  print $ sum $ zipWith (-) bs as
  putStrLn $ unwords $ map show bs

calc k a
  | length a == 0 = []
  | length a == 1 = a
  | length a > 1 && k-(a!!0)-(a!!1) > 0 = [a!!0] ++ calc k ([k-(a!!0)]++(drop 2 a))
  | otherwise = [a!!0] ++ calc k (drop 1 a)

f(_:k:a) = [[foldl (+) 0 [bi - ai | (ai, bi) <- zip a b]], b] where b = calc k a

main=interact$unlines.map(unwords.map show).f.map read.words

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)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: Int -> Int -> [Int] -> [Int] -> [Int]
  solve _ _ acc [] = acc
  solve k y acc (x:xs) =
    let z = max 0 (k - (y + x))
        in solve k (x + z) ((x + z):acc) xs

  diff :: [Int] -> [Int] -> Int
  diff [] [] = 0
  diff (x:xs) (y:ys) = (y - x) + (diff xs ys)

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . (map readInt) . words
    -- let xs = [2, 0, 1]
    xs <- getLine >>= return . (map readInt) . words
    let result = reverse $ solve k k [] xs
        d = diff xs result
    print d
    putStrLn $ intercalate " " $ map show result

main=interact$unlines.map(unwords.map show).f.map read.words
f(_:k:s)=[[sum$zipWith(-)(k#s)s],k#s]
k#(x:y:s)|x+y<k=x:k#((k-x):s)|0<1=x:k#(y:s)
k#s=s

import Control.Monad.Trans.State.Lazy( runStateT, modify)
import Control.Monad( forM_)
main = do
    let interpretLine = return.map (read::String->Int).words =<< getLine
    [n,k] <- interpretLine
    as <- interpretLine
    let entry [] = return 0
	entry [w] = modify (w:) >> return 0
	entry (w1:w2:ws)
	  | w1+w2 >= k	= do
		modify (w1:)
		entry $ w2:ws
	  | otherwise	= do
		let diff = k-w1-w2
		modify (w1:)
		v <- entry $ (w2+diff):ws
		return $ diff+v
    (additional, bs) <- runStateT (entry as) []
    print additional
    forM_  (reverse bs) $ \w -> putStr (show w) >> putStr " "

import Data.List

need k xs = 0 : (go xs)
  where go [_] = []
        go (y:ys:yss)
          | extra > 0 = extra : go ((extra + ys):yss)
          | otherwise = 0 : go (ys:yss)
          where extra = k - y - ys

amount :: [Int] -> Int
amount = sum

final = zipWith (+)

main = do
    [_, k] <- fmap (map read . words) getLine :: IO [Int]
    xs <- fmap (map read . words) getLine :: IO [Int]
    let s = need k xs
    print $ amount s
    putStrLn . concat . intersperse " " . map show . final s $ xs

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

plan :: [Int] -> Int -> Int -> [Int]
plan [] _ _ = []
plan (x:xs) k need = max need x : plan xs k (k - max need x)

readInt s = let Just (i, _) = C.readInt s in i

main = do
    (n:k:_) <- fmap (map readInt . C.words) C.getLine
    ar <- fmap (map readInt . C.words) C.getLine
    let result = plan ar k 0
    print $ sum $ zipWith subtract ar result
    putStr $ unwords $ map show result

module Main where

import Control.Monad
import Prelude
import Text.Printf
import Data.List

solve :: [Int] -> Int -> Int -> [Int]
solve [] _ _ = []
solve (a:as) k p = [c] ++ (solve as k c)
    where c = max a (k - p)

main = do
    [n, k] <- liftM (map read . words) getLine
    a <- liftM (map read . words) getLine
    let b = solve a k k
    printf "%d\n" ((sum b) - (sum a))
    forM_ [0..(length b) - 1] $ do \i -> printf "%d " (b !! i)

doit :: [Int] -> Int -> Int -> [Int]
doit [] _ _ = []
doit (x:xs) k last = let ne = last + x
                     in if ne < k then (k - last) : doit xs k (k - last) else x : doit xs k x

main = do
	[n, k] <- getLine >>= return . map read . words
	a <- getLine >>= return . map read . words
	let ans = doit a k k
	print $ sum ans - sum a
	putStrLn $ unwords $ map show ans

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

minIndex :: [Int] -> Int
minIndex cost = snd . minimum $ zip cost [0..]

solve :: [Int] -> (Int, [Int])
solve (k:a) = let path = [[] | i <- [0..k]]
                  cost = [0  | i <- [0..k]]
              in solve' path cost a
              where
                solve' :: [[Int]] -> [Int] -> [Int] -> (Int, [Int])
                solve' path cost [] = let index = minIndex cost
                                      in (cost !! index, reverse $ path !!index)
                solve' path cost (a:ax) = let (next_path, next_cost) = unzip $ map (trans a k path cost) [0..k]
                                          in solve' next_path next_cost ax

trans :: Int -> Int -> [[Int]] -> [Int] -> Int -> ([Int], Int)
trans a k path cost i = let costs = map trans' $ zip [0..] cost
                            index = minIndex costs
                        in (i : path !! index, costs !! index)
                        where trans' :: (Int, Int) -> Int
                              trans' (j, cost) | i < a || i < k - j = cost + 1000
                                               | otherwise = cost + i - a

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

solve :: [Int] -> (Int, [Int])
solve (n:k:a) | n == 1 = let extra = max 0 (k - (head a))
                         in (extra, [extra + head a])
              | otherwise = solve' 0 (head a) (tail a) 0 [head a]
                            where solve' :: Int -> Int -> [Int] -> Int -> [Int] -> (Int, [Int])
                                  solve' a b [] cost path = let extra = max 0 (k - a - b)
                                                            in (cost + extra, reverse (extra + head path : tail path))
                                  solve' a b (c:x) cost path = let extra = max 0 (k - a - b - c)
                                                                   walk = c + extra
                                                               in solve' b walk x (cost + extra) (walk : path)

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

pp = putStrLn

dostuff lst kk uu sum
  | (null lst) = ( (reverse uu), sum )
  | (diff > 0) = dostuff (tail lst) kk ((diff + (head lst)) : uu) (diff + sum)
  | otherwise = dostuff (tail lst) kk ((head lst) : uu) (sum)
  where diff = (kk - ((head uu) + (head lst)))

makestr lst uu
  | (null lst) = (reverse uu)
  | otherwise = makestr (tail lst) (" " ++ (show (head lst)) ++ uu)

main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      k = (read (last (words ff)))::Int

  gg <- getLine
  let hh = conv (words gg) []

      ans = dostuff (tail hh) k [(head hh)] 0

  pp (show (snd ans))
  pp (makestr (fst ans) [])

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ unlines.solve.tail.concat. map (map read.words).take 2. lines
solve :: [Integer]-> [String]
solve (x1:x2:[])=   map (unwords.(map show)) [[maximum [x1-x2,0]], [maximum [x1,x2]]]
solve (x:y:xs) = map (unwords.(map show))  [[maximum [sum ff - sum (y:xs),0]],ff] where
  ff=scanl f y xs
  f b a = maximum [x-b,a]

doit :: [Int] -> Int -> Int -> [Int]
doit [] _ _ = []
doit (x:xs) k last = let ne = last + x
                     in if ne < k then (k - last) : doit xs k (k - last) else x : doit xs k x

main = do
	[n, k] <- getLine >>= return . map read . words
	a <- getLine >>= return . map read . words
	let ans = doit a k k
	print $ sum ans
	putStrLn $ unwords $ map show ans