William has two arrays $$$a$$$ and $$$b$$$, each consisting of $$$n$$$ items.For some segments $$$l..r$$$ of these arrays William wants to know if it is possible to equalize the values of items in these segments using a balancing operation. Formally, the values are equalized if for each $$$i$$$ from $$$l$$$ to $$$r$$$ holds $$$a_i = b_i$$$.To perform a balancing operation an even number of indices must be selected, such that $$$l \le pos_1 < pos_2 < \dots < pos_k \le r$$$. Next the items of array a at positions $$$pos_1, pos_3, pos_5, \dots$$$ get incremented by one and the items of array b at positions $$$pos_2, pos_4, pos_6, \dots$$$ get incremented by one.William wants to find out if it is possible to equalize the values of elements in two arrays for each segment using some number of balancing operations, and what is the minimal number of operations required for that. Note that for each segment the operations are performed independently.

The first line contains a two integers $$$n$$$ and $$$q$$$ ($$$2 \le n \le 10^5$$$, $$$1 \le q \le 10^5$$$), the size of arrays $$$a$$$ and $$$b$$$ and the number of segments. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(0 \le a_i \le 10^9)$$$. The third line contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ $$$(0 \le b_i \le 10^9)$$$. Each of the next $$$q$$$ lines contains two integers $$$l_i$$$ and $$$r_i$$$ $$$(1 \le l_i < r_i \le n)$$$, the edges of segments.

For each segment output a single number — the minimal number of balancing operations needed or "-1" if it is impossible to equalize segments of arrays.

NoteFor the first segment from $$$2$$$ to $$$6$$$ you can do one operation with $$$pos = [2, 3, 5, 6]$$$, after this operation the arrays will be: $$$a = [0, 2, 2, 9, 4, 2, 7, 5]$$$, $$$b = [2, 2, 2, 9, 4, 2, 5, 8]$$$. Arrays are equal on a segment from $$$2$$$ to $$$6$$$ after this operation.For the second segment from $$$1$$$ to $$$7$$$ you can do three following operations:   $$$pos = [1, 3, 5, 6]$$$  $$$pos = [1, 7]$$$  $$$pos = [2, 7]$$$ After these operations, the arrays will be: $$$a = [2, 2, 2, 9, 4, 2, 7, 5]$$$, $$$b = [2, 2, 2, 9, 4, 2, 7, 8]$$$. Arrays are equal on a segment from $$$1$$$ to $$$7$$$ after these operations.For the third segment from $$$2$$$ to $$$4$$$ you can do one operation with $$$pos = [2, 3]$$$, after the operation arrays will be: $$$a = [0, 2, 2, 9, 3, 2, 7, 5]$$$, $$$b = [2, 2, 2, 9, 4, 1, 5, 8]$$$. Arrays are equal on a segment from $$$2$$$ to $$$4$$$ after this operation.It is impossible to equalize the fourth and the fifth segment.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Functor
import Data.Foldable
import Data.Traversable
import Data.Eq
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.List
import Data.IORef
import Data.Maybe
import Data.Ratio
import Data.Monoid
import Data.Either
import Data.String
import Data.Function
--import Data.Array
import Data.Array.ST
import Data.Array.Unboxed

import System.IO
import System.IO.Unsafe
import System.Exit
--import System.Random

import Control.Monad
import Control.Applicative
import Control.Arrow
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Fail
import Control.Monad.State.Lazy
import Control.Monad.Except
import Control.Monad.Trans.Except
import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.Except

import qualified Data.ByteString.Char8 as C

readWhileNSpace :: IO String
readWhileNSpace = do
    c <- getChar
    if c == '\n' || c == ' ' then
        return ""
    else do
        cs <- readWhileNSpace
        return (c:cs)

readInt :: IO Int
readInt = read <$> readWhileNSpace

readArr :: Int -> IO a -> IO [a]
readArr n readF = replicateM n readF

maxInArr :: Ord a => [a] -> a
maxInArr = foldr1 max

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

data SparseTable = SparseTable { table :: UArray (Int, Int) Int, func :: Int -> Int -> Int }

buildSparse :: Array Int Int -> (Int -> Int -> Int) -> SparseTable
buildSparse e f = SparseTable (runSTUArray $ do
    let n = length e
    let lg = il2 n
    let pws = (listArray (0, lg - 1) $ take lg $ iterate (*2) 1) :: Array Int Int
    sp <- newArray ((0, 0), (lg, n)) 0
    forM_ [0..n - 1] $ \j -> do
        writeArray sp (0, j) (e ! j)
    forM_ [1..lg] $ \i ->
        let p = (pws!(i - 1)) in
        forM_ [0..(n - 2 * p)] $ \j -> do
            l <- readArray sp (i - 1, j)
            r <- readArray sp (i - 1, j + p)
            writeArray sp (i, j) $ f l r
    return sp) f

sparseQuery :: SparseTable -> Int -> Int -> Int
sparseQuery (SparseTable sp f) l r = let lg = il2 (r - l + 1); pws = iterate (*2) 1
    in f (sp!(lg, l)) (sp!(lg, r - (pws!!lg) + 1))

solve :: SparseTable -> SparseTable -> Array Int Int -> IO ()
solve spmin spmax pf = do
    ~[l, r] <- readInts
    let min' = (sparseQuery spmin (l-1) (r-1)) - (pf!(l-1))
    let max' = (sparseQuery spmax (l-1) (r-1)) - (pf!(l-1))
    putStrLn $ show $ if max' > 0 || (pf!r) - (pf!(l-1)) /= 0 then (-1) else (-min')

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

main :: IO ()
main = do
    ~[n, q] <- readInts
    a <- readInts
    b <- readInts
    let delt = getZipList $ (-) <$> (ZipList a) <*> (ZipList b)
    let pf = scanl' (+) 0 delt
    let pf' = listArray (0, n) pf
    let spmin = buildSparse (listArray (0, n - 1) (drop 1 pf)) min
    let spmax = buildSparse (listArray (0, n - 1) (drop 1 pf)) max
    replicateM_ q $ solve spmin spmax pf'

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Functor
import Data.Foldable
import Data.Traversable
import Data.Eq
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.List
import Data.IORef
import Data.Maybe
import Data.Ratio
import Data.Monoid
import Data.Either
import Data.String
import Data.Function
--import Data.Array
import Data.Array.ST
import Data.Array.Unboxed

import System.IO
import System.IO.Unsafe
import System.Exit
--import System.Random

import Control.Monad
import Control.Applicative
import Control.Arrow
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Fail
import Control.Monad.State.Lazy
import Control.Monad.Except
import Control.Monad.Trans.Except
import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.Except

import qualified Data.ByteString.Char8 as C

readWhileNSpace :: IO String
readWhileNSpace = do
    c <- getChar
    if c == '\n' || c == ' ' then
        return ""
    else do
        cs <- readWhileNSpace
        return (c:cs)

readInt :: IO Int
readInt = read <$> readWhileNSpace

readArr :: Int -> IO a -> IO [a]
readArr n readF = replicateM n readF

maxInArr :: Ord a => [a] -> a
maxInArr = foldr1 max

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

data SparseTable = SparseTable { table :: UArray (Int, Int) Int, func :: Int -> Int -> Int }

buildSparse :: Array Int Int -> (Int -> Int -> Int) -> SparseTable
buildSparse e f = SparseTable (runSTUArray $ do
    let n = length e
    let lg = il2 n
    let pws = take lg $ iterate (*2) 1
    sp <- newArray ((0, 0), (lg, n)) 0
    forM_ [0..n - 1] $ \j -> do
        writeArray sp (0, j) (e ! j)
    forM_ [1..lg] $ \i ->
        let p = (pws !! (i - 1)) in
        forM_ [0..(n - 2 * p)] $ \j -> do
            l <- readArray sp (i - 1, j)
            r <- readArray sp (i - 1, j + p)
            writeArray sp (i, j) $ f l r
    return sp) f

sparseQuery :: SparseTable -> Int -> Int -> Int
sparseQuery (SparseTable sp f) l r = let pws = iterate (*2) 1; lg = il2 (r - l + 1)
    in f (sp!(lg, l)) (sp!(lg, r - (pws !! lg) + 1))

solve :: SparseTable -> SparseTable -> Array Int Int -> IO ()
solve spmin spmax pf = do
    ~[l, r] <- readInts
    let min' = (sparseQuery spmin (l-1) (r-1)) - (pf!(l-1))
    let max' = (sparseQuery spmax (l-1) (r-1)) - (pf!(l-1))
    putStrLn $ show $ if max' > 0 || (pf!r) - (pf!(l-1)) /= 0 then (-1) else (-min')

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

main :: IO ()
main = do
    ~[n, q] <- readInts
    a <- readInts
    b <- readInts
    let delt = getZipList $ (-) <$> (ZipList a) <*> (ZipList b)
    let pf = scanl' (+) 0 delt
    let pf' = listArray (0, n) pf
    let spmin = buildSparse (listArray (0, n - 1) (drop 1 pf)) min
    let spmax = buildSparse (listArray (0, n - 1) (drop 1 pf)) max
    replicateM_ q $ solve spmin spmax pf'

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Array.Unboxed
import Data.Bits
import Data.Int

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

type Sparse = (Array Int (UArray Int Int64), Int64 -> Int64 -> Int64)

query :: Sparse -> Int -> Int -> Int64
query (arr, fun) i j = let
  rank = il2 (j - i)
  rarr = arr ! rank
  in  fun (rarr ! i) (rarr ! (j + 1 - 1 `shift` rank))

construct :: (Int64 -> Int64 -> Int64) -> UArray Int Int64 -> Sparse
construct fun initArr = let
  step :: UArray Int Int64 -> Int -> UArray Int Int64
  step arr w = let
    (p, q) = bounds arr
    nq = q - w
    in  listArray (p, nq)
        $ [fun (arr ! i) (arr ! (i + w)) | i <- [p..nq]]
  (ip, iq) = bounds initArr
  lastLayer = il2 (iq - ip)
  ws = take lastLayer $ iterate (* 2) 1 -- this is why you should use pre-written code
  in  (listArray (0, lastLayer) $ scanl step initArr ws, fun)

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n,q] <- getInts 2
  a <- getInts n
  b <- getInts n
  let
    diffs = zipWith (-) b a
    psums = listArray (0, n) $ scanl' (\x y -> x + fromIntegral y) 0 diffs
    possible = construct min psums
    cost = construct max psums
    solve :: Int -> Int -> Maybe Int64
    solve li ri = do
      guard $ psums ! (li - 1) == psums ! ri
      guard $ query possible li ri >= psums ! ri
      pure $ query cost li ri - psums ! ri
  replicateM_ q $ do
    [li, ri] <- getInts 2
    putInt64s $ pure $ case  solve li ri  of
      Nothing -> 0-1
      Just k -> k

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Array.Unboxed
import Data.Bits
import Data.Int

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

type Sparse = (Array Int (UArray Int Int64), Int64 -> Int64 -> Int64)

query :: Sparse -> Int -> Int -> Int64
query (arr, fun) i j = let
  rank = il2 (j - i)
  rarr = arr ! rank
  in  fun (rarr ! i) (rarr ! (j + 1 - 1 `shift` rank))

construct :: (Int64 -> Int64 -> Int64) -> UArray Int Int64 -> Sparse
construct fun initArr = let
  step :: UArray Int Int64 -> Int -> UArray Int Int64
  step arr w = let
    (p, q) = bounds arr
    nq = q - w
    in  listArray (p, nq)
        $ [fun (arr ! i) (arr ! (i + w)) | i <- [p..nq]]
  (ip, iq) = bounds initArr
  lastLayer = il2 (iq - ip)
  in  (listArray (0, lastLayer) $ scanl step initArr [1..lastLayer], fun)

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n,q] <- getInts 2
  a <- getInts n
  b <- getInts n
  let
    diffs = zipWith (-) b a
    psums = listArray (0, n) $ scanl' (\x y -> x + fromIntegral y) 0 diffs
    possible = construct min psums
    cost = construct max psums
    solve :: Int -> Int -> Maybe Int64
    solve li ri = do
      guard $ psums ! (li - 1) == psums ! ri
      guard $ query possible li ri >= psums ! ri
      pure $ query cost li ri - psums ! ri
  replicateM_ q $ do
    [li, ri] <- getInts 2
    putInt64s $ pure $ case  solve li ri  of
      Nothing -> 0-1
      Just k -> k

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Array.Unboxed
import Data.Bits
import Data.Int

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

type Sparse = (Array Int (UArray Int Int64), Int64 -> Int64 -> Int64)

query :: Sparse -> Int -> Int -> Int64
query (arr, fun) i j = let
  rank = il2 (j - i)
  rarr = arr ! rank
  in  fun (rarr ! i) (rarr ! (j - 1 `shift` rank))

construct :: (Int64 -> Int64 -> Int64) -> UArray Int Int64 -> Sparse
construct fun initArr = let
  step :: UArray Int Int64 -> Int -> UArray Int Int64
  step arr w = let
    (p, q) = bounds arr
    nq = q - w
    in  listArray (p, nq)
        $ [fun (arr ! i) (arr ! (i + w)) | i <- [p..nq]]
  (ip, iq) = bounds initArr
  lastLayer = il2 (iq - ip)
  in  (listArray (0, lastLayer) $ scanl step initArr [1..lastLayer], fun)

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n,q] <- getInts 2
  a <- getInts n
  b <- getInts n
  let
    diffs = zipWith (-) b a
    psums = listArray (0, n) $ scanl' (\x y -> x + fromIntegral y) 0 diffs
    possible = construct min psums
    cost = construct max psums
    solve :: Int -> Int -> Maybe Int64
    solve li ri = do
      guard $ psums ! (li - 1) == psums ! ri
      guard $ query possible li ri >= psums ! ri
      pure $ query cost li ri - psums ! ri
  replicateM_ q $ do
    [li, ri] <- getInts 2
    putInt64s $ pure $ case  solve li ri  of
      Nothing -> 0-1
      Just k -> k

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Array.Unboxed
import Data.Bits

il2 :: Int -> Int
il2 x = finiteBitSize x - 1 - countLeadingZeros x

type Sparse = (Array Int (UArray Int Int), Int -> Int -> Int)

query :: Sparse -> Int -> Int -> Int
query (arr, fun) i j = let
  rank = il2 (j - i)
  rarr = arr ! rank
  in  fun (rarr ! i) (rarr ! (j - 1 `shift` rank))

construct :: (Int -> Int -> Int) -> UArray Int Int -> Sparse
construct fun initArr = let
  step :: UArray Int Int -> Int -> UArray Int Int
  step arr w = let
    (p, q) = bounds arr
    nq = q - w
    in  listArray (p, nq)
        $ [fun (arr ! i) (arr ! (i + w)) | i <- [p..nq]]
  (ip, iq) = bounds initArr
  lastLayer = il2 (iq - ip)
  in  (listArray (0, lastLayer) $ scanl step initArr [1..lastLayer], fun)

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n,q] <- getInts 2
  a <- getInts n
  b <- getInts n
  let
    psums = listArray (0, n) $ scanl' (+) 0 $ zipWith (-) b a
    possible = construct min psums
    cost = construct max psums
    solve :: Int -> Int -> Maybe Int
    solve li ri = do
      guard $ psums ! (li - 1) == psums ! ri
      guard $ query possible li ri >= psums ! ri
      pure $ query cost li ri - psums ! ri
  replicateM_ q $ do
    [li, ri] <- getInts 2
    putInts $ pure $ case  solve li ri  of
      Nothing -> 0-1
      Just k -> k

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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


Vasya follows a basketball game and marks the distances from which each team makes a throw. He knows that each successful throw has value of either 2 or 3 points. A throw is worth 2 points if the distance it was made from doesn't exceed some value of d meters, and a throw is worth 3 points if the distance is larger than d meters, where d is some non-negative integer.Vasya would like the advantage of the points scored by the first team (the points of the first team minus the points of the second team) to be maximum. For that he can mentally choose the value of d. Help him to do that.

The first line contains integer n (1 ≤ n ≤ 2·105) — the number of throws of the first team. Then follow n integer numbers — the distances of throws ai (1 ≤ ai ≤ 2·109).  Then follows number m (1 ≤ m ≤ 2·105) — the number of the throws of the second team. Then follow m integer numbers — the distances of throws of bi (1 ≤ bi ≤ 2·109).

Print two numbers in the format a:b — the score that is possible considering the problem conditions where the result of subtraction a - b is maximum. If there are several such scores, find the one in which number a is maximum.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

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;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
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 #-}

mask :: (Integral i) => i
mask = 0xffff
{-# INLINE mask #-}

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr   <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp   <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0     :: ST s (STUArray s Int Int)

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count (xi.&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  rep (mask+1) $ \i-> do
    unsafeWrite count i 0

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count ((xi`unsafeShiftR`16).&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- radixSort n.map readInt.B.words <$> B.getLine
  m <- readLn
  ys <- radixSort m.map readInt.B.words <$> B.getLine
  let (a,b) = solve n m xs ys
  putStrLn $ shows a ":" ++ show b

max' :: (Int,Int) -> (Int,Int) -> (Int,Int)
max' (!x,!y) (!z,!w) = case compare (x-y) (z-w) of
                         LT -> (z,w)
                         GT -> (x,y)
                         EQ ->max (x,y) (z,w)
{-# INLINE max' #-}

solve :: Int -> Int -> UArray Int Int -> UArray Int Int -> (Int,Int)
solve n m xs ys = foldl1' max' [resX,resY,score 0,score maxBound]
   where
     !resX = foldl1' max' $ map(score.unsafeAt xs)[0..n-1]
     !resY = foldl1' max' $ map(score.unsafeAt ys)[0..m-1]
     !headX = unsafeAt xs 0
     !lastX = unsafeAt xs (n-1)
     !headY = unsafeAt ys 0
     !lastY = unsafeAt ys (m-1)
     score :: Int -> (Int,Int)
     score d = (scoreX,scoreY)
      where
        !scoreX | d < headX = 3 * n
                | d < lastX, i<-lowerBound ((d<).unsafeAt xs) 0 (n-1) = 2 * i + 3 * (n-i)
                | otherwise = 2 * n
        !scoreY | d < headY = 3 * m
                | d < lastY, i<-lowerBound ((d<).unsafeAt ys) 0 (m-1) = 2 * i + 3 * (m-i)
                | otherwise = 2 * m

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

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;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
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 #-}

mask :: (Integral i) => i
mask = 0xffff
{-# INLINE mask #-}

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr   <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp   <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0     :: ST s (STUArray s Int Int)

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count (xi.&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  rep (mask+1) $ \i-> do
    unsafeWrite count i 0

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count ((xi`unsafeShiftR`16).&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- radixSort n.map readInt.B.words <$> B.getLine
  m <- readLn
  ys <- radixSort m.map readInt.B.words <$> B.getLine
  let (a,b) = solve n m xs ys
  putStrLn $ shows a ":" ++ show b

max' :: (Int,Int) -> (Int,Int) -> (Int,Int)
max' (!x,!y) (!z,!w)
  | x-y > z-w = (x,y)
  | otherwise = (z,w)
{-# INLINE max' #-}

solve :: Int -> Int -> UArray Int Int -> UArray Int Int -> (Int,Int)
solve n m xs ys = foldl1' max' [resX,resY,score 1,score maxBound]
   where
     !resX = foldl1' max' $ map(score.unsafeAt xs)[0..n-1]
     !resY = foldl1' max' $ map(score.unsafeAt ys)[0..m-1]
     !headX = unsafeAt xs 0
     !lastX = unsafeAt xs (n-1)
     !headY = unsafeAt ys 0
     !lastY = unsafeAt ys (m-1)
     score :: Int -> (Int,Int)
     score d = (scoreX,scoreY)
      where
        !scoreX | d < headX = 3 * n
                | d < lastX, i<-lowerBound ((d<).unsafeAt xs) 0 (n-1) = 2 * (i-1) + 3 * (n-i+1)
                | otherwise = 2 * n
        !scoreY | d < headY = 3 * m
                | d < lastY, i<-lowerBound ((d<).unsafeAt ys) 0 (m-1) = 2 * (i-1) + 3 * (m-i+1)
                | otherwise = 2 * m

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

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;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
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 #-}

mask :: (Integral i) => i
mask = 0xffff
{-# INLINE mask #-}

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr   <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp   <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0     :: ST s (STUArray s Int Int)

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count (xi.&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  rep (mask+1) $ \i-> do
    unsafeWrite count i 0

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count ((xi`unsafeShiftR`16).&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- radixSort n.map readInt.B.words <$> B.getLine
  m <- readLn
  ys <- radixSort m.map readInt.B.words <$> B.getLine
  let (a,b) = solve n m xs ys
  putStrLn $ shows a ":" ++ show b

max' :: (Int,Int) -> (Int,Int) -> (Int,Int)
max' (!x,!y) (!z,!w) = case compare (x-y) (z-w) of
                         LT -> (z,w)
                         GT -> (x,y)
                         EQ ->max (x,y) (z,w)
{-# INLINE max' #-}

solve :: Int -> Int -> UArray Int Int -> UArray Int Int -> (Int,Int)
solve n m xs ys = foldl1' max' [resX,resY,score 1,score maxBound]
   where
     !resX = foldl1' max' $ map(score.unsafeAt xs)[0..n-1]
     !resY = foldl1' max' $ map(score.unsafeAt ys)[0..m-1]
     !headX = unsafeAt xs 0
     !lastX = unsafeAt xs (n-1)
     !headY = unsafeAt ys 0
     !lastY = unsafeAt ys (m-1)
     score :: Int -> (Int,Int)
     score d = (scoreX,scoreY)
      where
        !scoreX | d < headX = 3 * n
                | d < lastX, i<-lowerBound ((d<).unsafeAt xs) 0 (n-1) = 2 * (i-1) + 3 * (n-i+1)
                | otherwise = 2 * n
        !scoreY | d < headY = 3 * m
                | d < lastY, i<-lowerBound ((d<).unsafeAt ys) 0 (m-1) = 2 * (i-1) + 3 * (m-i+1)
                | otherwise = 2 * m


Once upon a time DravDe, an outstanding person famous for his professional achievements (as you must remember, he works in a warehouse storing Ogudar-Olok, a magical but non-alcoholic drink) came home after a hard day. That day he had to drink 9875 boxes of the drink and, having come home, he went to bed at once.DravDe dreamt about managing a successful farm. He dreamt that every day one animal came to him and asked him to let it settle there. However, DravDe, being unimaginably kind, could send the animal away and it went, rejected. There were exactly n days in DravDe’s dream and the animal that came on the i-th day, ate exactly ci tons of food daily starting from day i. But if one day the animal could not get the food it needed, it got really sad. At the very beginning of the dream there were exactly X tons of food on the farm.DravDe woke up terrified...When he retold the dream to you, he couldn’t remember how many animals were on the farm by the end of the n-th day any more, but he did remember that nobody got sad (as it was a happy farm) and that there was the maximum possible amount of the animals. That’s the number he wants you to find out. It should be noticed that the animals arrived in the morning and DravDe only started to feed them in the afternoon, so that if an animal willing to join them is rejected, it can’t eat any farm food. But if the animal does join the farm, it eats daily from that day to the n-th.

The first input line contains integers n and X (1 ≤ n ≤ 100, 1 ≤ X ≤ 104) — amount of days in DravDe’s dream and the total amount of food (in tons) that was there initially. The second line contains integers ci (1 ≤ ci ≤ 300). Numbers in the second line are divided by a space.

Output the only number — the maximum possible amount of animals on the farm by the end of the n-th day given that the food was enough for everybody.

NoteNote to the first example: DravDe leaves the second and the third animal on the farm. The second animal will eat one ton of food on the second day and one ton on the third day. The third animal will eat one ton of food on the third day.

import IO
import List

main = do
	i <- openFile "input.txt" ReadMode
	o <- openFile "output.txt" WriteMode
	c <- hGetContents i
	hPutStr o $ show $ gao $ map read $ words c
	hClose o

gao (n:x:c) = length $ takeWhile (<=x) $ scanl1 (+) $ sort $ zipWith (*) [1 ..] $ reverse c

{-# LANGUAGE ForeignFunctionInterface #-}

import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe
import Data.List (sort, maximumBy, minimum, foldl')
import Data.Array
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Debug.Trace

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
{-# INLINE unsafeReadDouble #-}
readDouble = unsafeReadDouble . SB.concat . LB.toChunks
readInt = fst . fromJust . LB.readInt

debug :: Show a => a -> b -> b
debug = trace . show
--debug _ = id

main = readFile "input.txt" >>= (writeFile "output.txt" . show . solve . parse . lines)

parse :: [String] -> (Int, [Int])
parse [nx, s] =
  let [n, x] = map read . words $ nx
      c = map read . words $ s
  in (x, c)

solve (x, c) =
  let n = length c
      v = takeWhile (<= x) $ scanl (+) 0 $ sort [(n - i) * (c !! i) | i <- [0..n - 1]]
  in length v - 1


You are a given an array $$$a$$$ of length $$$n$$$. Find a subarray $$$a[l..r]$$$ with length at least $$$k$$$ with the largest median.A median in an array of length $$$n$$$ is an element which occupies position number $$$\lfloor \frac{n + 1}{2} \rfloor$$$ after we sort the elements in non-decreasing order. For example: $$$median([1, 2, 3, 4]) = 2$$$, $$$median([3, 2, 1]) = 2$$$, $$$median([2, 1, 2, 1]) = 1$$$.Subarray $$$a[l..r]$$$ is a contiguous part of the array $$$a$$$, i. e. the array $$$a_l,a_{l+1},\ldots,a_r$$$ for some $$$1 \leq l \leq r \leq n$$$, its length is $$$r - l + 1$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \leq k \leq n \leq 2 \cdot 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq n$$$).

Output one integer $$$m$$$ — the maximum median you can get.

NoteIn the first example all the possible subarrays are $$$[1..3]$$$, $$$[1..4]$$$, $$$[1..5]$$$, $$$[2..4]$$$, $$$[2..5]$$$ and $$$[3..5]$$$ and the median for all of them is $$$2$$$, so the maximum possible median is $$$2$$$ too.In the second example $$$median([3..4]) = 3$$$.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE TypeApplications #-}

module Main ( main ) where

import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.List
import Data.Char ( isSpace )

main :: IO ()
main = do
  [n, k] <- line
  a <- arr (n - 1) <$> line
  let
    medianIsGE m = any (\i -> psums ! i - pmins ! (i - k) > 0) [k..n]
      where
        psums = arr n $ scanl' (+) 0 $ (\e -> if e < m then -1 else 1 :: Int) <$> elems a
        pmins = arr n $ scanl' min 0 $ tail $ elems psums
  print $ upperBound medianIsGE 1 n

arr :: Int -> [Int] -> UArray Int Int
arr n = listArray @UArray (0 :: Int, n)

upperBound :: Integral a => (a -> Bool) -> a -> a -> a
upperBound f = go
  where
    go lo hi
      | hi - lo <= 1 = if f hi then hi else lo
      | otherwise    = if f mi then go mi hi else go lo mi
      where
        mi = (lo + hi) `div` 2

line :: IO [Int]
line = parseBS <$> BS.getLine

parseBS :: BS.ByteString -> [Int]
parseBS = go
  where
    go b = case BS.readInt b of
      Just (n, r) -> n:go (BS.dropWhile isSpace r)
      Nothing     -> []

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List hiding (insert)
import Data.Semigroup

-- length at least k, not length exactly k

import Data.Array.Unboxed

longestMedian :: [Int] -> Int -> Int -> Int
longestMedian a n x = let
  -- O(n)
  -- length of the longest segment with median at least x
  vals = scanl (\ct y -> ct + if  y >= x  then  1  else  0-1) 0 a
  firstVisits :: UArray Int Int
  lastVisits :: UArray Int Int
  firstVisits = accumArray min maxBound (0-n, n) $ zip vals [0..]
  lastVisits  = accumArray max minBound (0-n, n) $ zip vals [0..]
  prevs = scanl min maxBound $ elems firstVisits
  in  foldl' max 0 $ zipWith (-) (elems lastVisits) prevs

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  a <- readInts
  let
    go li ri = if  li == ri
      then  li
      else  let
      mi = div (li + ri) 2
      in  if  longestMedian a n mi >= k
      then  go (mi + 1) ri
      else  go li mi
  putInts [go 1 (n+1) - 1]

type SIO = StateT P.ByteString IO

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

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

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

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE TypeApplications #-}

module Main ( main ) where

import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.List
import Data.Char ( isSpace )

main :: IO ()
main = do
  [n, k] <- line
  a <- arr (n - 1) <$> line
  let
    medianIsGE m = any (\i -> psums ! i - pmins ! (i - k) > 0) [k..n]
      where
        psums = arr n $ scanl' (+) 0 $ (\e -> if e < m then -1 else 1 :: Int) <$> elems a
        pmins = arr n $ scanl' min 0 $ elems psums
  print $ upperBound medianIsGE 1 n

arr :: Int -> [Int] -> UArray Int Int
arr n = listArray @UArray (0 :: Int, n)

upperBound :: Integral a => (a -> Bool) -> a -> a -> a
upperBound f = go
  where
    go lo hi
      | hi - lo <= 1 = if f hi then hi else lo
      | otherwise    = if f mi then go mi hi else go lo mi
      where
        mi = (lo + hi) `div` 2

line :: IO [Int]
line = parseBS <$> BS.getLine

parseBS :: BS.ByteString -> [Int]
parseBS = go
  where
    go b = case BS.readInt b of
      Just (n, r) -> n:go (BS.dropWhile isSpace r)
      Nothing     -> []

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE TypeApplications #-}

module Main ( main ) where

import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.List
import Data.Char ( isSpace )

main :: IO ()
main = do
  [n, k] <- line
  a <- arr (n - 1) <$> line
  let
    medianIsGE m = any (\i -> psums ! i - pmins ! (i - k) > 0) [k..n]
      where
        psums = arr n $ scanl' (+) 0 $ (\e -> if e < m then -1 else 1 :: Int) <$> elems a
        pmins = arr n $ scanl' min 0 $ elems psums
  print $ upperBound medianIsGE 1 n

arr :: Int -> [Int] -> UArray Int Int
arr n = listArray @UArray (0 :: Int, n)

upperBound :: Integral a => (a -> Bool) -> a -> a -> a
upperBound f = go
  where
    go lo hi
      | hi - lo <= 1 = lo
      | otherwise    = if f mi then go mi hi else go lo mi
      where
        mi = (lo + hi) `div` 2

line :: IO [Int]
line = parseBS <$> BS.getLine

parseBS :: BS.ByteString -> [Int]
parseBS = go
  where
    go b = case BS.readInt b of
      Just (n, r) -> n:go (BS.dropWhile isSpace r)
      Nothing     -> []

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List hiding (insert)
import Data.Semigroup

import qualified Data.IntMap.Strict as M

data Split = Split
  { smallVals :: !(M.IntMap Int)
  , largeVals :: !(M.IntMap Int)
  , imbalance :: !Int
  } deriving (Eq, Show)

getMedian :: Split -> Int
getMedian s = case  M.maxViewWithKey $ smallVals s  of
  Nothing           -> maxBound
  Just ((v, _), _)  -> v

empty :: Split
empty = Split M.empty M.empty 0

remOne :: Int -> Maybe Int
remOne x = if  x == 1
  then  Nothing
  else  Just (x-1)

correctBalance :: Split -> Split
correctBalance inp@(Split lv rv lean)
  | lean < -1 = let
      (toMove, _) = M.findMax lv
      newlv = M.updateMax remOne lv
      newrv = M.insertWith (+) toMove 1 rv
      in  Split newlv newrv $ lean + 2
  | lean > 0 = let
      (toMove, _) = M.findMin rv
      newlv = M.insertWith (+) toMove 1 lv
      newrv = M.updateMin remOne rv
      in  Split newlv newrv $ lean - 2
  | otherwise = inp

insert :: Int -> Split -> Split
insert x s@(Split lv rv lean) = correctBalance $ if  x <= getMedian s
  then  Split (M.insertWith (+) x 1 lv) rv (lean - 1)
  else  Split lv (M.insertWith (+) x 1 rv) (lean + 1)

remove :: Int -> Split -> Split
remove x s@(Split lv rv lean) = correctBalance $ if  x <= getMedian s
  then  Split (M.update remOne x lv) rv (lean + 1)
  else  Split lv (M.update remOne x rv) (lean - 1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  a <- readInts
  let
    (sa, ta) = splitAt k a
    initSplit = foldl' (flip insert) empty sa
    update currSplit (new, old) = insert new $ remove old currSplit
    allSplits = scanl update initSplit $ zip ta a
  putInts [foldl' max minBound $ map getMedian allSplits]

type SIO = StateT P.ByteString IO

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

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

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


Omkar has received a message from Anton saying "Your story for problem A is confusing. Just make a formal statement." Because of this, Omkar gives you an array $$$a = [a_1, a_2, \ldots, a_n]$$$ of $$$n$$$ distinct integers. An array $$$b = [b_1, b_2, \ldots, b_k]$$$ is called nice if for any two distinct elements $$$b_i, b_j$$$ of $$$b$$$, $$$|b_i-b_j|$$$ appears in $$$b$$$ at least once. In addition, all elements in $$$b$$$ must be distinct. Can you add several (maybe, $$$0$$$) integers to $$$a$$$ to create a nice array $$$b$$$ of size at most $$$300$$$? If $$$a$$$ is already nice, you don't have to add any elements.For example, array $$$[3, 6, 9]$$$ is nice, as $$$|6-3|=|9-6| = 3$$$, which appears in the array, and $$$|9-3| = 6$$$, which appears in the array, while array $$$[4, 2, 0, 6, 9]$$$ is not nice, as $$$|9-4| = 5$$$ is not present in the array.For integers $$$x$$$ and $$$y$$$, $$$|x-y| = x-y$$$ if $$$x > y$$$ and $$$|x-y| = y-x$$$ otherwise.

Each test contains multiple test cases. The first line contains $$$t$$$ ($$$1 \leq t \leq 50$$$), the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ distinct integers $$$a_1, a_2, \cdots, a_n$$$ ($$$-100 \leq a_i \leq 100$$$) — the elements of the array $$$a$$$.

For each test case, output one line containing YES if Omkar can create a nice array $$$b$$$ by adding elements to $$$a$$$ and NO otherwise. The case of each letter does not matter, so yEs and nO will also be accepted. If the first line is YES, output a second line containing a single integer $$$k$$$ ($$$n \leq k \leq 300$$$).  Then output one line containing $$$k$$$ distinct integers $$$b_1, b_2, \cdots, b_k$$$ ($$$-10^9 \leq b_i \leq 10^9$$$), the elements of the nice array $$$b$$$. $$$b_1, b_2, \cdots, b_k$$$ can be in any order. For each $$$a_i$$$ in $$$a$$$, $$$a_i$$$ must appear at least once in $$$b$$$. It can be proved that if Omkar can create such an array $$$b$$$, then he can also do so in a way that satisfies the above constraints. If multiple solutions exist, you can print any.

-- uninhm
-- https://codeforces.com/contest/1536/problem/A
-- greedy

import Control.Monad (replicateM_)

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

solution = unlines [ "YES"
                   , "101"
                   , unwords (map show [0..100])
                   ]

main = do
  t <- getInt
  replicateM_ t $ do
    n <- getInt
    a <- getInts
    if any (< 0) a then
      putStrLn "NO"
    else
      putStr solution

-- uninhm
-- https://codeforces.com/contest/1536/problem/A
-- greedy

import Control.Monad (replicateM_)

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

solution = unlines [ "YES"
                   , "101"
                   , unwords (map show [0..100])
                   ]

main = do
  t <- getInt
  replicateM_ t $ do
    n <- getInt
    a <- getInts
    if or [ i < 0 | i <- a ] then
      putStrLn "NO"
    else
      putStr solution

-- uninhm
-- https://codeforces.com/contest/1536/problem/A
-- greedy

import Control.Monad (replicateM_)

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

solution = unlines [ "YES"
                   , "101"
                   , unwords (map show [0..100])
                   ]

main = do
  t <- getInt
  replicateM_ t $ do
    n <- getInt
    a <- getInts
    if or [ True | i <- a, i<0 ] then
      putStrLn "NO"
    else
      putStr solution

import Control.Monad (replicateM_)

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

solution = "YES\n" ++ "101\n" ++ unwords (map show [0..100]) ++ "\n"

main = do
  t <- getInt
  replicateM_ t $ do
    n <- getInt
    a <- getInts
    if or [ True | i <- a, i<0 ] then
      putStrLn "NO"
    else
      putStr solution

module Main where

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            mn = minimum a
            mx = maximum a
        putStrLn $
            if mn < 0 then
                "NO"
            else
                "YES\n" ++ show(mx + 1) ++ "\n" ++
                    (concat $ map (\x -> show x ++ " ") [0..mx])

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

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

module Main where

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            [mn, mx] = [minimum a, maximum a]
        putStrLn $
            if mn < 0 then
                "NO"
            else
                "YES\n" ++ show(mx + 1) ++ "\n" ++
                    (concat $ map (\x -> show x ++ " ") [0..mx])

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

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

readSpaceLine :: Read (a) => IO [a]
readSpaceLine = do ln <- getLine
                   return . map read $ words ln

doTestCase ::  IO()
doTestCase = do _ <- getLine
                ns <- readSpaceLine :: IO [Int]
                if minimum ns < 0
                   then putStrLn "NO"
                   else let m = maximum ns
                            in do putStrLn "YES"
                                  print $ m + 1
                                  putStrLn . unwords . map show $ [0..maximum ns]

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

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

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

main :: IO ()
main = do
    [caseNum] <- getInts
    forM_ [1..caseNum] $ \_ -> do
        [n] <- getInts
        arr <- getInts

        let areNeg = length ([x | x <- arr, x < 0]) > 0

        if areNeg then do
            printf("No\n")
        else do
            printf("Yes\n")
            let sol = [0..100]
            printf ("%d\n") (length sol)

            C.putStrLn $ C.pack $ unwords $ map show $ sol

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	getLine
	as <- readInts
	let
		g = foldl1 gcd as
		ma = maximum as
		res = takeWhile ( <= ma ) [ i * g | i <- [ 0 .. ] ]
	if minimum as < 0
		then putStrLn "No"
		else do
			putStrLn "Yes"
			print $ length res
			printList $ res

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- getInts
    let result = if any (<0) as
                   then string7 "NO"
                   else string7 "YES\n101\n" `mappend` (mconcat $ intersperse (charUtf8 ' ') $ map intDec [0..100])
    return $ result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    if length (filter (<0) a) > 0 then putStrLn "NO"
    else do
        putStrLn "YES"
        let m = maximum a
        print $ m + 1
        putStrLn . unwords . map show $ [0..m]

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

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

printS = do
    n <- readLn::IO Int
    xs <- readInts
    let nega = any (<0) xs
    if nega then putStrLn"no"
    else do putStrLn "YES"
            print $ maximum xs + 1
            putStrLn . unwords . map show $ [0..(maximum xs)]

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

import Data.List (intercalate)
import Control.Monad (replicateM)

main = do t <- read <$> getLine
          replicateM t solve

solve = do getLine
           xs <- (map read . words) <$> getLine
           putStrLn (if any (< 0) xs then "nO" else ("yEs\n101\n" ++ intercalate " " (map show [0..100])))

makeInteger :: [String] -> [Int]
makeInteger = map read

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

solve :: Int -> IO()
solve 0 = return ()
solve t = do
    solve2
    solve (t - 1)

solve2 :: IO()
solve2 = do
    line <- getLine
    let n = (read line::Int)
    line <- getLine
    let inparr = words line
    let arr = makeInteger inparr
    let arr2 = [ if x < 0 then False else True | x <- arr ]
    let ck = elem False arr2
    if ck then do
        putStrLn "NO"
    else do
        putStrLn "YES"
        putStrLn "101"
        let arrprint = [show x | x <- [0..100]]
        let strprint = unwords arrprint
        putStrLn strprint

module Main where

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            [mn, mx] = [minimum a, maximum a]
        putStrLn $
            if mn < 0 then
                "NO"
            else
                "YES\n" ++ show(mx + 1) ++ "\n" ++
                    (concat $ map (\x -> show x ++ " ") [0..mx + 1])

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

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

readSpaceLine :: Read (a) => IO [a]
readSpaceLine = do ln <- getLine
                   return . map read $ words ln

doTestCase ::  IO()
doTestCase = do _ <- getLine
                ns <- readSpaceLine :: IO [Int]
                if minimum ns < 0
                   then putStrLn "NO"
                   else let m = maximum ns
                            in do putStrLn "YES"
                                  print m
                                  putStrLn . unwords . map show $ [0..maximum ns]

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

readSpaceLine :: Read (a) => IO [a]
readSpaceLine = do ln <- getLine
                   return . map read $ words ln

doTestCase ::  IO()
doTestCase = do _ <- getLine
                ns <- readSpaceLine :: IO [Int]
                if minimum ns < 0
                   then putStrLn "NO"
                   else do putStrLn "YES"
                           putStrLn . unwords . map show $ [0..maximum ns]

main = do t <- readLn :: IO Int
          sequence_ $ replicate t doTestCase

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

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

main :: IO ()
main = do
    [caseNum] <- getInts
    forM_ [1..caseNum] $ \_ -> do
        arr <- getInts

        let areNeg = length ([x | x <- arr, x < 0]) > 0

        if areNeg then do
            printf("No\n")
        else do
            printf("Yes\n")
            let sol = [0..100]
            printf ("%d\n") (length sol)

            C.putStrLn $ C.pack $ unwords $ map show $ sol

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	getLine
	as <- readInts
	let
		g = foldl1 gcd as
		ma = maximum as
		res = takeWhile ( <= ma ) [ i * g | i <- [ 0 .. ] ]
	if minimum as < 0
		then putStrLn "No"
		else do
			print $ length res
			printList $ res

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- getInts
    let result = if any (<0) as
                   then string7 "NO"
                   else string7 "101\n" `mappend` (mconcat $ intersperse (charUtf8 ' ') $ map intDec [0..100])
    return $ result `mappend` charUtf8 '\n'
  hPutBuilder stdout output


You have a string of decimal digits s. Let's define bij = si·sj. Find in matrix b the number of such rectangles that the sum bij for all cells (i, j) that are the elements of the rectangle equals a in each rectangle.A rectangle in a matrix is a group of four integers (x, y, z, t) (x ≤ y, z ≤ t). The elements of the rectangle are all cells (i, j) such that x ≤ i ≤ y, z ≤ j ≤ t.

The first line contains integer a (0 ≤ a ≤ 109), the second line contains a string of decimal integers s (1 ≤ |s| ≤ 4000).

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

{-# 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.Char
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.Base(unsafeAt)
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

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

main = do
    a <- readLn
    s <- map digitToInt <$> getLine
    print $ solve a s

solve :: Int -> [Int] -> Integer
solve a l | a == 0    = cast (count ! 0) * (cast (n * (n+1) - count ! 0))
          | otherwise = sum [ cast v * cast (count ! x)| (m,v) <- assocs count, m > 0, v > 0,
                  let (x,y) = divMod a m ,y == 0, x <= 4000*9]
    where
    n = length l
    s :: UArray Int Int
    s = listArray (0,n) (scanl (+) 0 l)
    as = [(unsafeAt s j - unsafeAt s (i-1),1) | i <- [1..n], j <- [i..n]]
    count :: UArray Int Int
    count = accumArray (+) 0 (0,4000*9) as
    cast = fromIntegral

{-
check = do
    a <- randomRIO (0,100)
    n <- return 2
    l <- replicateM n (randomRIO (1,9))
    print (a,n,l)
    print $ solve a l
    -}

import Control.Monad (liftM, replicateM)
import Data.Array ((!), listArray)
import Data.Char (ord, digitToInt)
import Data.List (intercalate, group, sort, unfoldr)

(?) :: Bool -> a -> a -> a
(?) p a b  =  if p then a else b

isPrime :: Integral a => a -> Bool
isPrime n  =  all (\x -> n `mod` x /= 0)
    $ takeWhile (\x -> x*x <= n) primes

primes :: Integral a => [a]
primes  =  2 : filter isPrime [3,5..]

factorization :: Integral a => a -> [(a, a)]
factorization 0  =  error "Don't factorization zero."
factorization 1  =  [(2,0)]
factorization n  =  f n primes
  where
    f 1 _  =  []
    f n (p:ps)
      | n `mod` p == 0  =  (p, a) : f m ps
      | p * p > n  =  [(n, 1)]
      | otherwise  =  f n ps
      where
        (m, a)  =  f' n 0
        f' n i
          | n `mod` p == 0  =  f' (n `div` p) (succ i)
          | otherwise  =  (n, i)

dividers :: Integral a => a -> [a]
dividers 0  =  error "Don't dividers zero."
dividers n  =  sort $ map (product . zipWith (^) ps) as
  where
    (ps, final)  =  unzip $ factorization n
    start  =  map (const 0) ps
    as  =  start : unfoldr next start
    next curr
      | curr == final  =  Nothing
      | otherwise  =  Just (a, a)
      where
        a  =  replicate i 0
            ++ [(curr !! i) + 1]
            ++ drop (i+1) curr
        i  =  length $ takeWhile (== 0) $ zipWith (-) final curr

solve :: Integer -> [Integer] -> Integer
solve 0 s  =  sum (map g z) - sum [f i * f j | i <- z, j <- z]
  where
    z  =  map (fromIntegral . length) $ filter ((== 0) . head) $ group s
    n  =  fromIntegral $ length s
    f n  =  n * (n+1) `div` 2
    g m  =  2 * f m * f n
solve k s  =  sum [countA i * countA (k `div` i) | i <- dividers k]
  where
    n  =  length s
    a  =  listArray (1, n) s
    zerosL  =  listArray (1, n) $ init
        $ scanl (\a b -> (b == 0) ? (a + 1) $ 0) 0 s
    zerosR  =  listArray (1, n) $ tail
        $ scanr (\a b -> (a == 0) ? (b + 1) $ 0) 0 s

    countA m  =  countA' m 1 1 (a ! 1)
    countA' m l r s
      | l > n  =  0
      | a ! l == 0  =  countA' m (l+1) r s
      | r < l  =  countA' m l (r+1) (s + a ! (r+1))
      | s == m  =  (1 + zerosL ! l) * (1 + zerosR ! r) + countA' m (l+1) r (s - a ! l)
      | s < m  =  if r == n then 0 else countA' m l (r+1) (s + a ! (r+1))
      | s > m  =  countA' m (l+1) r (s - a ! l)

main :: IO ()
main  =  do
    k  <-  readLn
    s  <-  liftM (map (fromIntegral . digitToInt)) getLine
    print $ solve k s

{-# LANGUAGE BangPatterns #-}
import Data.Char (ord)
import Data.Int (Int64)
import Data.List (tails)
import Control.Applicative ((<$>))
import Data.Array.Unboxed (UArray, accumArray, assocs, (!))

solve :: Int -> String -> Int64
solve acc str
    | acc == 0  = (n * (n + 1) - zero) * zero
    | otherwise = sum . map count . filter pred . tail . assocs $ cnt
    where
    n = fromIntegral $ length str :: Int64
    a = scanl (+) 0 $ map ((+ inc).ord) str :: [Int]
        where inc = - ord '0'

    b = concat . map chunk . tails $ a
        where
        chunk     [] = []
        chunk (x:xs) = map (+ (-x)) xs

    size = last a :: Int
    cnt = accumArray (+) 0 (0, size) . zip b $ repeat 1 :: UArray Int Int64

    zero = cnt ! 0

    pred (_, 0) = False
    pred (i, _) = acc `mod` i == 0

    count (i, j)
        | size < i' = 0
        | otherwise = j * cnt ! i'
        where i' = acc `div` i

main = do
    acc <- read <$> getLine
    str <- getLine
    print $ solve acc str


Professor GukiZ has two arrays of integers, a and b. Professor wants to make the sum of the elements in the array a sa as close as possible to the sum of the elements in the array b sb. So he wants to minimize the value v = |sa - sb|.In one operation professor can swap some element from the array a and some element from the array b. For example if the array a is [5, 1, 3, 2, 4] and the array b is [3, 3, 2] professor can swap the element 5 from the array a and the element 2 from the array b and get the new array a [2, 1, 3, 2, 4] and the new array b [3, 3, 5].Professor doesn't want to make more than two swaps. Find the minimal value v and some sequence of no more than two swaps that will lead to the such value v. Professor makes swaps one by one, each new swap he makes with the new arrays a and b.

The first line contains integer n (1 ≤ n ≤ 2000) — the number of elements in the array a. The second line contains n integers ai ( - 109 ≤ ai ≤ 109) — the elements of the array a. The third line contains integer m (1 ≤ m ≤ 2000) — the number of elements in the array b. The fourth line contains m integers bj ( - 109 ≤ bj ≤ 109) — the elements of the array b.

In the first line print the minimal value v = |sa - sb| that can be got with no more than two swaps. The second line should contain the number of swaps k (0 ≤ k ≤ 2). Each of the next k lines should contain two integers xp, yp (1 ≤ xp ≤ n, 1 ≤ yp ≤ m) — the index of the element in the array a and the index of the element in the array b in the p-th swap. If there are several optimal solutions print any of them. Print the swaps in order the professor did them.

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray (bounds, elems, listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, STUArray)
import Data.Int (Int64)
import Data.List (inits, minimumBy, sort, tails)
import Data.Ord (comparing)
import Data.Maybe (catMaybes)
import Data.STRef (newSTRef, readSTRef, writeSTRef)
import System.Random

qsort gen xs = runSTUArray $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STUArray s Int Int64)
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a
main = do
  getLine
  as <- map read . words <$> getLine :: IO [Int64]
  getLine
  bs <- map read . words <$> getLine :: IO [Int64]

  gen <- newStdGen

  let
    s1 = sum as
    s2 = sum bs

    r0 = (abs $ s2-s1, [])
    r1 = (d, [(x, y)])
      where
        (d, x, y) = minimum [(abs $ s2-s1+2*a-2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    r2 = if length as > 1 && length bs > 1 then [(d, [(i, ii), (j, jj)])] else []
      where
        (d, bb, i, j) = minimum [(d, bb, i, j) | (a, i) <- zip as [1..], (b, j) <- zip as [1..], i < j, let (d, bb) = find (a+b)]
          where
            bbs = qsort gen [2*(b1+b2) | (b1:bs') <- tails bs, b2 <- bs'] :: UArray Int Int64

            find aa = find' 1 (snd $ bounds bbs)
              where
                bb' = s2-s1+2*aa

                find' l r
                  | v == bb' = (0, bb' `div` 2)
                  | l >= r = minimum [(abs $ bb - bb', bb `div` 2) | i <- [l-1..l], i >= 1, let bb = bbs!i]
                  | v < bb' = find' (m+1) r
                  | otherwise = find' l m
                  where
                    m = (l+r) `div`2
                    v = bbs!m

        (ii, jj) = head [(i, j) | (a, i) <- zip bs [1..], (b, j) <- zip bs [1..], i < j, a+b == bb]

    (d, l) = minimumBy (comparing (\(d, l) -> (d, length l))) $ [r0, r1] ++ r2

  print d
  print $ length l
  putStr $ unlines $ map (\(x, y) -> show x ++ " " ++ show y) l

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Data.Array (listArray, (!))
import Data.List (sort)
import Data.Int (Int64)
-- import Debug.Trace (trace)

main = do
  getLine
  as <- (map read . words) `fmap` getLine :: IO [Int64]
  getLine
  bs <- (map read . words) `fmap` getLine :: IO [Int64]

  let
    s1 = sum as
    s2 = sum bs

    d0 = abs $ s1 - s2

    (d1, x, y) = minimum [(abs $ s1 - s2 - 2*a + 2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    (d2, x1, y1, x2, y2) = if null l || null la then (10^9, 0, 0, 0, 0) else minimum (map f l)
      where
        a = listArray (1, length la) la
        la = sort $ [(a + b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip as [1..], y > x]
        l = [(a + b, x, y) | (a, x) <- zip bs [1..], (b, y) <- zip bs [1..], y > x]

        f (p2, x2, y2) = (d, x1, y1, x2, y2)
          where
            t = - ((s2 - p2) - (s1 + p2))

            (d, x1, y1) = search 1 $ length la
              where
                search l r
                  | r-l < 3 = minimum [(abs (2*d - t), x, y) | i <- [l..r], let (d, x, y) = a ! i]
                  | v1 > v2 = search m1 r
                  | otherwise = search l m2
                  where
                    m1 = l + (r-l) `div` 3
                    m2 = r - (r-l) `div` 3

                    (a1, _, _) = a ! m1
                    (a2, _, _) = a ! m2

                    v1 = abs $ 2*a1-t
                    v2 = abs $ 2*a2-t

  -- print d0
  -- print d1
  -- print d2
  -- putStrLn ""

  if d0 <= d2 && d0 <= d1
     then do
       print d0
       print 0
     else if d1 <= d2 && d1 <= d0
      then do
        print d1
        print 1
        putStrLn $ show x ++ " " ++ show y
      else do
        print d2
        print 2
        putStrLn $ show x1 ++ " " ++ show x2
        putStrLn $ show y1 ++ " " ++ show y2

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray (bounds, elems, listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, STUArray)
import Data.Int (Int64)
import Data.List (inits, minimumBy, sort)
import Data.Ord (comparing)
import Data.Maybe (catMaybes)
import Data.STRef (newSTRef, readSTRef, writeSTRef,)
import System.Random

qsort gen xs = runSTUArray $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STUArray s Int Int64)
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a
main = do
  getLine
  as <- map read . words <$> getLine :: IO [Int64]
  getLine
  bs <- map read . words <$> getLine :: IO [Int64]

  gen <- newStdGen

  let
    s1 = sum as
    s2 = sum bs

    r0 = (abs $ s2-s1, [])
    r1 = (d, [(x, y)])
      where
        (d, x, y) = minimum [(abs $ s2-s1+2*a-2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    r2 = if length as > 1 && length bs > 1 then [(d, [(i, ii), (j, jj)])] else []
      where
        (d, bb, i, j) = minimum [(d, bb, i, j) | (a, i) <- zip as [1..], (b, j) <- zip as [1..], i < j, let (d, bb) = find (a+b)]
          where
            bbs = qsort gen [2*(b1+b2) | b1 <- bs, b2 <- bs] :: UArray Int Int64

            find aa = find' 1 (snd $ bounds bbs)
              where
                bb' = s2-s1+2*aa

                find' l r
                  | r - l < 3 = minimum [(abs $ bb - bb', bb `div` 2) | i <- [l..r], let bb = bbs!i]
                  | v1 > v2 = find' m1 r
                  | otherwise = find' l m2
                  where
                    (m1, m2) = (l + s, r - s) where s = (r-l) `div` 3
                    (v1, v2) = (bbs!m1, bbs!m2)

        (ii, jj) = head $ catMaybes [find (bb-x) (ii+1) | (x, ii) <- zip bs [1..]]
          where
            n = length bs
            a = listArray (1, n) $ sort $ zip bs [1..] :: Array Int (Int64, Int)

            find x l = find' l n
              where
                find' l r
                  | v == x = Just (l, i)
                  | l >= r = Nothing
                  | v < x = find' m r
                  | otherwise = find' l m
                  where
                    m = (l+r) `div` 2
                    (v, i) = a ! m

    (d, l) = minimumBy (comparing (\(d, l) -> (d, length l))) $ [r0, r1] ++ r2

  print d
  print $ length l
  putStr $ unlines $ map (\(x, y) -> show x ++ " " ++ show y) l

import Data.List (sort)

import Data.Array (listArray, (!))
-- import Debug.Trace (trace)

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

  let
    s1 = sum as
    s2 = sum bs

    d0 = abs $ s1 - s2

    (d1, x, y) = minimum [(abs $ s1 - s2 - 2*a + 2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    (d2, x1, y1, x2, y2) = if null l then (10^9, 0, 0, 0, 0) else minimum (map f l)
      where
        a = listArray (1, length la) la
        la = sort $ [(a + b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip as [1..], y > x]
        l = [(a + b, x, y) | (a, x) <- zip bs [1..], (b, y) <- zip bs [1..], y > x]

        f (p2, x2, y2) = (d, x1, y1, x2, y2)
          where
            t = - ((s2 - p2) - (s1 + p2))

            (d, x1, y1) = search 1 $ length la
              where
                search l r
                  | r-l < 3 = minimum [(abs (2*d - t), x, y) | i <- [l..r], let (d, x, y) = a ! i]
                  | v1 > v2 = search m1 r
                  | otherwise = search l m2
                  where
                    m1 = l + (r-l) `div` 3
                    m2 = r - (r-l) `div` 3

                    (a1, _, _) = a ! m1
                    (a2, _, _) = a ! m2

                    v1 = abs $ 2*a1-t
                    v2 = abs $ 2*a2-t

  -- print d0
  -- print d1
  -- print d2
  -- putStrLn ""

  if d0 <= d2 && d0 <= d1
     then do
       print d0
       print 0
     else if d1 <= d2 && d1 <= d0
      then do
        print d1
        print 1
        putStrLn $ show x ++ " " ++ show y
      else do
        print d2
        print 2
        putStrLn $ show x1 ++ " " ++ show y1
        putStrLn $ show x2 ++ " " ++ show y2

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}

import Data.Array.IArray (listArray, (!))
-- import Data.List (sort)
import Data.Int (Int64)
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
-- import Debug.Trace (trace)

import Control.Monad (when)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import System.Random

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  getLine
  as <- (map read . words) `fmap` getLine :: IO [Int64]
  getLine
  bs <- (map read . words) `fmap` getLine :: IO [Int64]

  gen <- getStdGen

  let
    s1 = sum as
    s2 = sum bs

    d0 = abs $ s1 - s2

    (d1, x, y) = minimum [(abs $ s1 - s2 - 2*a + 2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    (d2, x1, y1, x2, y2) = if null l || null la then (10^16, 0, 0, 0, 0) else minimum (map f l)
      where
        a = listArray (1, length la) la :: UArray Int Int64
        la = sort gen $ [a + b | (a, x) <- zip as [1..], (b, y) <- zip as [1..], y > x]

        l = [(a + b, x, y) | (a, x) <- zip bs [1..], (b, y) <- zip bs [1..], y > x]

        xys = listArray (1, length l) $ l :: Array Int (Int, Int)
          where
            l = [(x, y) | (a, x) <- zip as [1..], (b, y) <- zip as [1..], y > x]

        f (p2, x2, y2) = (d, x1, y1, x2, y2)
          where
            t = - ((s2 - p2) - (s1 + p2))

            (d, x1, y1) = search 1 $ length la
              where
                search l r
                  | r-l < 3 = minimum [(abs (2*d - t), x, y) | i <- [l..r], let d = a ! i, let (x, y) = xys ! i]
                  | v1 > v2 = search m1 r
                  | otherwise = search l m2
                  where
                    m1 = l + (r-l) `div` 3
                    m2 = r - (r-l) `div` 3

                    a1 = a ! m1
                    a2 = a ! m2

                    v1 = abs $ 2*a1-t
                    v2 = abs $ 2*a2-t

  if d0 <= d2 && d0 <= d1
     then do
       print d0
       print 0
     else if d1 <= d2 && d1 <= d0
      then do
        print d1
        print 1
        putStrLn $ show x ++ " " ++ show y
      else do
        print d2
        print 2
        putStrLn $ show x1 ++ " " ++ show x2
        putStrLn $ show y1 ++ " " ++ show y2

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray (bounds, elems, listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, STUArray)
import Data.Int (Int64)
import Data.List (inits, minimumBy, sort, tails)
import Data.Ord (comparing)
import Data.Maybe (catMaybes)
import Data.STRef (newSTRef, readSTRef, writeSTRef)
import System.Random
-- import Debug.Trace (trace)

qsort gen xs = runSTUArray $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STUArray s Int Int64)
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a
main = do
  getLine
  as <- map read . words <$> getLine :: IO [Int64]
  getLine
  bs <- map read . words <$> getLine :: IO [Int64]

  gen <- newStdGen

  let
    s1 = sum as
    s2 = sum bs

    r0 = (abs $ s2-s1, [])
    r1 = (d, [(x, y)])
      where
        (d, x, y) = minimum [(abs $ s2-s1+2*a-2*b, x, y) | (a, x) <- zip as [1..], (b, y) <- zip bs [1..]]

    r2 = if length as > 1 && length bs > 1 then [(d, [(i, ii), (j, jj)])] else []
      where
        (d, bb, i, j) = minimum [(d, bb, i, j) | (a, i) <- zip as [1..], (b, j) <- zip as [1..], i < j, let (d, bb) = find (a+b)]
          where
            bbs = qsort gen [2*(b1+b2) | (b1:bs') <- tails bs, b2 <- bs'] :: UArray Int Int64

            find aa = r -- trace ("aa = " ++ show aa ++ " bb = " ++ show bb' ++ " r =" ++ show r) $ r
              where
                r = find' 1 (snd $ bounds bbs)
                bb' = s2-s1+2*aa

                find' l r
                  | r - l < 3 = minimum [(abs $ bb - bb', bb `div` 2) | i <- [l..r], let bb = bbs!i]
                  | v1 < v2 = find' m1 r
                  | otherwise = find' l m2
                  where
                    (m1, m2) = (l + s, r - s) where s = (r-l) `div` 3
                    (v1, v2) = (abs $ bb' - bbs!m1, abs $ bb' - bbs!m2)

        (ii, jj) = head $ catMaybes [find (bb-x) (ii+1) | (x, ii) <- zip bs [1..]]
          where
            n = length bs
            a = listArray (1, n) $ sort $ zip bs [1..] :: Array Int (Int64, Int)

            find x l = find' l n
              where
                find' l r
                  | v == x = Just (l, i)
                  | l >= r = Nothing
                  | v < x = find' m r
                  | otherwise = find' l m
                  where
                    m = (l+r) `div` 2
                    (v, i) = a ! m

    (d, l) = minimumBy (comparing (\(d, l) -> (d, length l))) $ [r0, r1] ++ r2

  -- print $ fst r0
  -- print r1
  -- print r2

  print d
  print $ length l
  putStr $ unlines $ map (\(x, y) -> show x ++ " " ++ show y) l


There is a street with $$$n$$$ houses in a line, numbered from $$$1$$$ to $$$n$$$. The house $$$i$$$ is initially painted in color $$$c_i$$$. The street is considered beautiful if all houses are painted in the same color. Tom, the painter, is in charge of making the street beautiful. Tom's painting capacity is defined by an integer, let's call it $$$k$$$.On one day, Tom can do the following repainting process that consists of two steps:   He chooses two integers $$$l$$$ and $$$r$$$ such that $$$ 1 \le l \le r \le n $$$ and $$$ r - l + 1 = k $$$.  For each house $$$i$$$ such that $$$l \le i \le r$$$, he can either repaint it with any color he wants, or ignore it and let it keep its current color. Note that in the same day Tom can use different colors to repaint different houses.Tom wants to know the minimum number of days needed to repaint the street so that it becomes beautiful.

The first line of input contains a single integer $$$t$$$ ($$$ 1 \le t \le 10^4$$$), the number of test cases. Description of test cases follows. In the first line of a test case description there are two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 10^5$$$). The second line contains $$$n$$$ space-separated integers. The $$$i$$$-th of these integers represents $$$c_i$$$ ($$$1 \le c_i \le 100$$$), the color which house $$$i$$$ is initially painted in. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

Print $$$t$$$ lines, each with one integer: the minimum number of days Tom needs to make the street beautiful for each test case.

NoteIn the first test case Tom should paint houses 1 and 2 in the first day in color 2, houses 5 and 6 in the second day in color 2, and the last house in color 2 on the third day.In the second test case Tom can, for example, spend 6 days to paint houses 1, 2, 4, 5, 6, 7 in color 3.In the third test case Tom can paint the first house in the first day and houses 6, 7, and 8 in the second day in color 3.

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process ([_, k]:xs:xss) = solve k xs : process xss

solve :: Int -> [Int] -> Int
solve k xs = minimum [cost c xs | c <- [1 .. 100]]
  where
    cost c xs
      | null xs = 0
      | head xs == c = cost c (tail xs)
      | otherwise = 1 + cost c (drop k xs)

import Control.Monad
import Data.List

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    [n, k] <- (map read . words) <$> getLine :: IO [Int]
    houses <- (map read . words) <$> getLine :: IO [Int]
    let colors = nub houses
    putStrLn $ show $ minimum $ map (daysToPaint k houses) colors

daysToPaint :: Int -> [Int] -> Int -> Int
daysToPaint k houses color = daysToPaint' houses color 0
  where
    daysToPaint' [] color counter = counter
    daysToPaint' (house:houses) color counter =
      if color == house
      then daysToPaint' houses color counter
      else daysToPaint' (drop (k-1) houses) color (counter + 1)

-- {-# LANGUAGE
--     BangPatterns
--   , BlockArguments
--   , DataKinds
--   , DeriveGeneric
--   , DerivingStrategies
--   , DerivingVia
--   , FlexibleContexts
--   , FlexibleInstances
--   , GADTs
--   , GeneralizedNewtypeDeriving
--   , KindSignatures
--   , LambdaCase
--   , MultiParamTypeClasses
--   , MultiWayIf
--   , NPlusKPatterns
--   , NegativeLiterals
--   , OverloadedLabels
--   , OverloadedStrings
--   , ParallelListComp
--   , PolyKinds
--   , RankNTypes
--   , ScopedTypeVariables
--   , StrictData
--   , TupleSections
--   , TypeApplications
--   , TypeFamilies
--   , TypeOperators
--   , UndecidableInstances
--   , ViewPatterns
--   #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import qualified Data.ByteString.Char8         as BS
import           Data.Char
import           Data.Foldable
import           Data.Functor
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup                 ( Max(..)
                                                , Min(..)
                                                , All(..)
                                                , Arg(..)
                                                )
import           Data.Ratio
-- import           Data.Vector.Unboxing.Mutable   ( Unboxable )
-- import qualified Data.Vector.Unboxing.Mutable  as V
-- import           System.IO
-- import           Data.Proxy
-- import           GHC.TypeLits
-- import           GHC.Generics                   ( Generic )
-- import           GHC.Exts
-- import           Control.Monad.Primitive        ( PrimMonad(PrimState) )
-- import           Control.Monad.Trans.Class      ( MonadTrans(lift) )

-- {-# ANN module ("Hlint: ignore Unused LANGUAGE pragma" :: String) #-}
-- {-# ANN module ("Hlint: ignore Reduce duplication" :: String) #-}

twice :: (a -> a -> b) -> a -> b
twice f x = f x x

both :: Arrow a => a b c -> a (b, b) (c, c)
both = twice (***)

readsLn :: Read a => IO [a]
readsLn = mapM readIO . words =<< getLine

getInt :: IO Int
getInt = fst . fromJust . BS.readInt <$> BS.getLine

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

getInteger :: IO Integer
getInteger = fst . fromJust . BS.readInteger <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . BS.readInteger) . BS.words <$> BS.getLine

main = do
  t <- getInt
  replicateM_ t $ do
    [n, k] <- getInts
    c      <- getInts
    print $ minimum [ solve col k 0 c 0 | col <- [1 .. 100] ]

solve _ _ _ [] ans = ans
solve col k 0 (c : cs) ans =
  if c == col then solve col k 0 cs ans else solve col k k (c : cs) (ans + 1)
solve col k t (_ : cs) ans = solve col k (t -1) cs ans

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process ([_, k]:xs:xss) = solve k xs : process xss

solve :: Int -> [Int] -> Int
solve k xs = minimum [cost c xs | c <- [1 .. 100]]
  where
    cost _ [] = 0
    cost c (x:xs)
      | c == x = cost c xs
      | otherwise = 1 + cost c (drop k xs)

import Control.Monad
import Data.List
import qualified Data.Map.Strict as Map

precolored :: [(Int, Int)] -> Map.Map Int Int
precolored xs = undefined

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    [n, k] <- (map read . words) <$> getLine :: IO [Int]
    colors <- (map read . words) <$> getLine :: IO [Int]
    --print $ map (\x -> (head x, div (length x) k)) (group colors)
    let precolored = Map.fromListWith (+) $ map (\x -> (head x, div (length x) k)) (group colors)
    let (dominantColor, dominantCount) = Map.foldrWithKey maxWithKey (0, 0) precolored
    let wrongGroup =  filter (/= [dominantColor]) $ groupBy (wrongColor dominantColor) colors
    let groupWork = sum $ map (\x -> ceiling $ (fromIntegral $ length x) / (fromIntegral k)) wrongGroup
    putStrLn $ show $ groupWork

wrongColor :: Int -> Int -> Int -> Bool
wrongColor correct a b = (a /= correct && b /= correct)

maxWithKey :: Int -> Int -> (Int, Int) -> (Int, Int)
maxWithKey key value (oldKey, oldValue) = if value > oldValue then (key, value) else (oldKey, oldValue)


You are given a digital clock with $$$n$$$ digits. Each digit shows an integer from $$$0$$$ to $$$9$$$, so the whole clock shows an integer from $$$0$$$ to $$$10^n-1$$$. The clock will show leading zeroes if the number is smaller than $$$10^{n-1}$$$.You want the clock to show $$$0$$$ with as few operations as possible. In an operation, you can do one of the following:   decrease the number on the clock by $$$1$$$, or  swap two digits (you can choose which digits to swap, and they don't have to be adjacent). Your task is to determine the minimum number of operations needed to make the clock show $$$0$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — number of digits on the clock. The second line of each test case contains a string of $$$n$$$ digits $$$s_1, s_2, \ldots, s_n$$$ ($$$0 \le s_1, s_2, \ldots, s_n \le 9$$$) — the number on the clock. Note: If the number is smaller than $$$10^{n-1}$$$ the clock will show leading zeroes.

For each test case, print one integer: the minimum number of operations needed to make the clock show $$$0$$$.

NoteIn the first example, it's optimal to just decrease the number $$$7$$$ times.In the second example, we can first swap the first and last position and then decrease the number by $$$1$$$.In the third example, the clock already shows $$$0$$$, so we don't have to perform any operations.

import qualified Data.Char as DC

solve :: Int -> IO ()
solve _ = do
    n <- getLine
    s <- getLine
    let xs = map DC.digitToInt (init s)
        lstdig = DC.digitToInt (last s)
        ans = lstdig + sum [x + 1 | x <- xs, x /= 0]
    print(ans)
main = do
    tc <- getLine
    let testcase = read tc :: Int
    mapM_ solve [1..testcase]

import Control.Monad
import Data.List
import Data.Char (digitToInt)

calc :: [Int] -> Int
calc s =
  foldl (\acc (x,i) ->
           if x==0 then
             acc
           else if i==0 then
             acc+x
           else
             acc+x+1
           ) 0 $ zip s [0..]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    unused <- getLine
    line <- getLine
    print $ calc $ reverse $ map digitToInt line


Let's denote that some array $$$b$$$ is bad if it contains a subarray $$$b_l, b_{l+1}, \dots, b_{r}$$$ of odd length more than $$$1$$$ ($$$l < r$$$ and $$$r - l + 1$$$ is odd) such that $$$\forall i \in \{0, 1, \dots, r - l\}$$$ $$$b_{l + i} = b_{r - i}$$$.If an array is not bad, it is good.Now you are given an array $$$a_1, a_2, \dots, a_n$$$. Some elements are replaced by $$$-1$$$. Calculate the number of good arrays you can obtain by replacing each $$$-1$$$ with some integer from $$$1$$$ to $$$k$$$.Since the answer can be large, print it modulo $$$998244353$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n, k \le 2 \cdot 10^5$$$) — the length of array $$$a$$$ and the size of "alphabet", i. e., the upper bound on the numbers you may use to replace $$$-1$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$a_i = -1$$$ or $$$1 \le a_i \le k$$$) — the array $$$a$$$.

Print one integer — the number of good arrays you can get, modulo $$$998244353$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.ST.Lazy.Safe (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy.Safe as STL
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  [n,k_] <- map readInt . words <$> getLine
  let k = toI64 k_
  as <- A.listArray (1,n) . unfoldr (runStateT rIntS) <$> BS.getLine
     :: IO (UArray Int Int)
  let oddval = group $ map (as A.!) [1,3..n]
      evenval = group $ map (as A.!) [2,4..n]
      lp0 [g] | head g == -1  = ends k (length g - 1) `mult` k
              | length g == 1 = 1
              | otherwise     = 0
      lp0 (g:gs) | head g == -1  = lp gs (head g) $ ends k (length g)
                 | length g == 1 = lp gs (head g) 1
                 | otherwise     = 0
      lp [g] !prev !acc | head g == -1  = acc `mult` ends k (length g)
                        | length g == 1 = acc
                        | otherwise = 0
      lp (g:gs) !prev !acc
        | head g == -1
        = lp gs (head g) $ acc `mult` mids k (length g) (prev == head (head gs))
        | length g == 1 = lp gs (head g) $ acc
        | otherwise = 0
  print $! lp0 oddval `mult` lp0 evenval

ends :: Int64 -> Int -> Int64
ends k j = foldl' mult 1 $ replicate j $! (k-1)

mids :: Int64 -> Int -> Bool -> Int64
mids k j isEq = snd $  (!! (j-1))
  $ iterate (\(!eq,!neq) -> (neq ,mult eq (k-1) `plus` mult neq (k-2)))
  $ if isEq then (0,k-1) else (1,k-2)

modulus :: Int64
modulus = 998244353

plus :: Int64 -> Int64 -> Int64
plus x y = if x+y >= modulus then x+y-modulus else x+y

mult :: Int64 -> Int64 -> Int64
mult x y = (x * y) `mod` modulus

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N