Door's family is going celebrate Famil Doors's birthday party. They love Famil Door so they are planning to make his birthday cake weird!The cake is a n × n square consisting of equal squares with side length 1. Each square is either empty or consists of a single chocolate. They bought the cake and randomly started to put the chocolates on the cake. The value of Famil Door's happiness will be equal to the number of pairs of cells with chocolates that are in the same row or in the same column of the cake. Famil Doors's family is wondering what is the amount of happiness of Famil going to be?Please, note that any pair can be counted no more than once, as two different cells can't share both the same row and the same column.

In the first line of the input, you are given a single integer n (1 ≤ n ≤ 100) — the length of the side of the cake. Then follow n lines, each containing n characters. Empty cells are denoted with '.', while cells that contain chocolates are denoted by 'C'.

Print the value of Famil Door's happiness, i.e. the number of pairs of chocolate pieces that share the same row or the same column.

NoteIf we number rows from top to bottom and columns from left to right, then, pieces that share the same row in the first sample are:   (1, 2) and (1, 3)  (3, 1) and (3, 3)  Pieces that share the same column are:   (2, 1) and (3, 1)  (1, 3) and (3, 3)

import Control.Monad

sol :: [[Int]] -> Int
sol a = sum(map (\x -> (x * (x-1)) `div` 2) (map sum a))

transpose:: [[a]]->[[a]]
transpose ([]:_) = []
transpose x = (map head x) : transpose (map tail x)

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [[Char]]
  let inputs_b = map (\x -> (map (\y -> if y == 'C' then 1 else 0) x)) inputs
  let inputs_t = transpose inputs_b
  print ((sol inputs_b) + (sol inputs_t))

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

import qualified Data.ByteString.Char8 as C

tr x =
    if (x == 'C') then 1 else 0

main :: IO ()
main = do
    a <- (fst.fromJust.C.readInt) <$> C.getLine
    b <- sequence $ replicate a $ (map tr) <$> getLine
    print $ sum (((\x->x*(x-1)`div`2).sum) <$> b) + sum (((\x->x*(x-1)`div`2).sum) <$> transpose b)

import System.IO
import Control.Monad
import Data.List

main = loop

loop = do done <- isEOF
          if done
              then do putStrLn ""
              else do size <- getLine
                      input <- replicateM (read size) getLine
                      print (calculate input)
                      loop

calculate :: [String] -> Int
calculate [] = 0
calculate (x:xs) = (sum(foldr g [] (x:xs))) + (sum (foldr g [] (transpose (x:xs))))
    where
        g :: [Char] -> [Int] -> [Int]
        g (x:xs) y = (combinations (sum (map f (x:xs)))):y
        f :: Char -> Int
        f 'C' = 1
        f '.' = 0

combinations :: Int -> Int
combinations x = quot (x * (x - 1)) 2

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  n <- fmap read getLine
  inp <- forM [1..n] $ \_ -> getLine
  print (solve inp)

solve :: [String] -> Int
solve inp = sum (map g rows) + sum (map g cols)
    where
      rows = map (foldl f 0) inp
      cols = map (foldl f 0) (transpose inp)
      f s 'C' = s + 1
      f s _ = s
      g x = x*(x-1)`div`2

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
-- import           Data.Array
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Char8 as C
-- import           Data.ByteString.Char8 ()
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

myread = read :: String -> Int
main = do
  n <- readLn
  nss <- replicateM n getLine
  print $ solve nss (transpose nss)

solve :: [String] -> [String] -> Int
solve nss mss = (sum (map count nss)) + (sum (map count mss)) where
  count :: String -> Int
  count = comb2 . length . filter (=='C')

comb2 :: Int -> Int
comb2 1 = 0
comb2 0 = 0
comb2 n = n*(n-1)`div`2

import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Control.Monad
import Control.Applicative
import Data.List
readInt :: C.ByteString -> Int

readInt = fst . fromJust . C.readInt

getInts = map readInt . C.words <$> C.getLine

countLetters :: String -> Char -> Int
countLetters str c = length $ filter (== c) str

main :: IO ()
main = do
    (n:_) <- getInts
    input <- replicateM n getLine
    let counts = getCounts input
    let input2 = transpose input
    let counts2 = getCounts input2
    let counts3 = counts2 ++ counts
    let result = foldl getResult 0 counts3
    print result
    where
        getCounts = map (flip countLetters 'C')
        getResult acc count = acc + count * (count - 1) `div` 2

import Control.Applicative
import Data.List

cou x = div (a*(a-1)) 2
	where a = length $ filter (=='C') x

process s = sum $ map cou s
main= do
	getLine
	s<- lines <$> getContents::IO [String]
	let t = transpose s
	print $ sum $ map process [s,t]

import Data.List (transpose)

combination :: Int -> Int -> Integer
combination n r
    | r == 0 = 1
    | n >= r && r > 0 = (product [(n'-r'+1)..n']) `div` (product [1..r'])
    | otherwise = 0
    where
        n' = fromIntegral n
        r' = fromIntegral r

process :: [[Char]] -> Integer
process ss = sum (map f ss) + sum (map f (transpose ss))
    where
        n = length ss
        f x = combination (length $ filter ('C'==) x) 2

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    ss <- fmap lines getContents
    print $ process ss

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

-- Meat
solve :: [String] -> Integer
solve ss = subsolve ss + (subsolve . transpose) ss

subsolve :: [String] -> Integer
subsolve = sum . fmap ((\x -> toInteger $ x * (x-1) `div` 2). length . filter (=='C'))

-- Shit
main :: IO ()
main = do
        (_:ss)  <- readShit
        printShit $ solve ss

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-
instructions go here...
-}

module Main where
import Data.List(transpose)

solve :: [String] -> Int
solve cake = countPairs cake + countPairs (transpose cake)

countPairs lines = sum $ map countPairs' lines
  where countPairs' line = sum $ map snd $ zip (filter (== 'C') line) [0..]

getLines :: Int -> IO [String]
getLines n = sequence $ replicate n getLine

main :: IO ()
main = do
  line <- getLine
  let n = read line :: Int
  cake <- getLines n
  let pairs = solve cake
  putStrLn $ show pairs


There are $$$n$$$ districts in the town, the $$$i$$$-th district belongs to the $$$a_i$$$-th bandit gang. Initially, no districts are connected to each other.You are the mayor of the city and want to build $$$n-1$$$ two-way roads to connect all districts (two districts can be connected directly or through other connected districts).If two districts belonging to the same gang are connected directly with a road, this gang will revolt.You don't want this so your task is to build $$$n-1$$$ two-way roads in such a way that all districts are reachable from each other (possibly, using intermediate districts) and each pair of directly connected districts belong to different gangs, or determine that it is impossible to build $$$n-1$$$ roads to satisfy all the conditions.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$2 \le n \le 5000$$$) — the number of districts. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the gang the $$$i$$$-th district belongs to. It is guaranteed that the sum of $$$n$$$ does not exceed $$$5000$$$ ($$$\sum n \le 5000$$$).

For each test case, print:   NO on the only line if it is impossible to connect all districts satisfying the conditions from the problem statement.  YES on the first line and $$$n-1$$$ roads on the next $$$n-1$$$ lines. Each road should be presented as a pair of integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, y_i \le n; x_i \ne y_i$$$), where $$$x_i$$$ and $$$y_i$$$ are two districts the $$$i$$$-th road connects.  For each road $$$i$$$, the condition $$$a[x_i] \ne a[y_i]$$$ should be satisfied. Also, all districts should be reachable from each other (possibly, using intermediate districts).

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.Bool (bool)
import safe Data.List (intercalate)

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

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

solve :: [Int] -> String
solve xs
  | all (== a) xs = "NO"
  | otherwise = intercalate "\n" ("YES" : map (unwords . map show) edges)
  where
    a = head xs
    ys = zip xs [1 ..]
    i = snd . head $ filter ((/= a) . fst) ys
    edges = map (\(b, j) -> [bool 1 i (a == b), j]) (tail ys)

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List

main :: IO ()
main = do
  cases::Int <- read <$> getLine
  forM_ [1..cases] (\cn -> do
      n::Int <- read <$> getLine
      gang::[Int] <- (map read) <$> words <$> getLine
      let gangs2 = zip [1..] gang
      let gangs = groupBy (\(_, a) (_, b) -> a == b) $ sortBy (\(_, a) (_, b) -> compare a b) gangs2
      if (length $ gangs) == 1 then
        putStrLn "NO"
      else do
        let ganged = map (\x -> (head x, length x, x)) $ gangs
        let sorted = sortBy (\(_, a, _) (_, b, _) -> compare a b) ganged
        -- putStrLn "--------------"
        -- print gang
        -- print gangs
        -- print sorted
        -- putStrLn "--------------"
        let (a, b, p) = head sorted
        let start_point = head p
        let rest_ganged = tail sorted ++ [(a, b - 1, tail p)]
        putStrLn "YES"
        go start_point rest_ganged
        pure ()
      pure ()
    )
  pure ()
       where go _ [] = pure ()
             go s k@((_, _, ls):xs) = do
               forM_ ls $ (\a -> putStrLn $ (show $ fst $ s) ++ " " ++ (show $ fst $ a))
               go (head ls) xs

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
  [t] <- getInts
  replicateM_ t $ do
    _ <- getInts
    as <- getInts
    let (xs, ys) = partition (\(a, _) -> a == head as) $ zip as [(1 :: Int) .. ]
        put i ps = mapM_ (\(_, j) -> printf "%d %d\n" i j :: IO ()) ps
    if null ys then printf "NO\n"
               else do
                 let (_, i) = head xs
                     (_, j) = head ys
                 printf "YES\n"
                 printf "%d %d\n" i j
                 put i (tail ys)
                 put j (tail xs)

import Control.Monad

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    a <- readInts
    let  x = maximum a
    case  all (== x) a  of
      True -> putStrLn "NO"
      False -> do
        putStrLn "YES"
        let
          ps@(p:_) = [i | (i, y) <- zip [1..] a, y == x] :: [Int]
          (q : qs) = [i | (i, y) <- zip [1..] a, y /= x] :: [Int]
        forM_ ps $ \cp -> putStrLn . unwords $ map show [q, cp]
        forM_ qs $ \cq -> putStrLn . unwords $ map show [p, cq]

import Control.Monad
import qualified Data.Map as Map
import Data.List (sort, group)

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

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
    t <- readInt
    replicateM_ t $ do
        n <- readInt
        a <- readInts
        putStr $ formatOutput $ solve a

getPos :: [Int] -> (Map.Map Int Int)
getPos a = mp
          where n = length a
                mp = Map.fromList [(x, i) | i <- [0..(n - 1)], let x = a !! i]

getNext :: [Int] -> (Map.Map Int Int)
getNext a = mp
          where a' = map head $ group $ sort a
                n = length a'
                mp = Map.fromList [(a' !! i, a' !! j) | i <- [0..(n - 1)], let j = if i == n - 1 then 0 else (i + 1)]

solve :: [Int] -> (Bool, [(Int, Int)])
solve a = if length next <= 1 then (False, []) else (True, [(i, y) | i <- [0..(n-2)], let x = a !! i, let y = pos Map.! (next Map.! x)])
      where
            n = length a
            next = getNext a
            pos  = getPos a

formatOutput :: (Bool, [(Int, Int)]) -> String
formatOutput (False, _) = "NO\n"
formatOutput (True, a) = unlines $ "YES":[show (x + 1) ++ " " ++ show (y + 1) | (x, y) <- a]

import Control.Monad (forM_)
import Data.List (group, sortBy)

solve :: String -> ([Int], [Int], Bool)
solve s = (fl, nfl, length nfl /= 0)
  where s' = zip [1..] ws
	fl = map fst . filter (\x -> snd x == h) $ s'
	nfl = map fst . filter (\x -> snd x /= h) $ s'
	h = head ws
	ws = words s

combine :: [Int] -> [Int] -> [(Int, Int)]
combine fl nfl = tp ++ tp'
  where h = head fl
	t = tail fl
	l = last nfl
	tp = [(h, x) | x <- nfl]
	tp' = [(x, l) | x <- t]

ts :: (Int, Int) -> String
ts (x, y) = show x ++ " " ++ show y

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] . const $ getLine >> getLine >>=  \x -> do
	(fl, nfl, b) <- pure . solve $ x
	if b then do
	  putStrLn "Yes"
	  mapM_ (putStrLn . ts) . combine fl $ nfl
	else putStrLn "No"

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List

main :: IO ()
main = do
  cases::Int <- read <$> getLine
  forM_ [1..cases] (\cn -> do
      n::Int <- read <$> getLine
      gang::[Int] <- (map read) <$> words <$> getLine
      let gangs2 = zip [1..] gang
      let gangs = groupBy (\(_, a) (_, b) -> a == b) $ sortBy (\(_, a) (_, b) -> compare a b) gangs2
      if (length $ gangs) == 1 then
        putStrLn "NO"
      else do
        let ganged = map (\x -> (head x, length x, x)) $ gangs
        let sorted = sortBy (\(_, a, _) (_, b, _) -> compare a b) ganged
        -- putStrLn "--------------"
        -- print gang
        -- print gangs
        -- print sorted
        -- putStrLn "--------------"
        let (a, b, p) = head sorted
        let start_point = head p
        let rest_ganged = tail sorted ++ [(a, b - 1, tail p)]
        putStrLn "YES"
        go start_point rest_ganged
        pure ()
      pure ()
    )
  pure ()
       where go _ [] = pure ()
             go s k@((_, _, ls):xs) = do
               forM_ ls $ (\a -> putStrLn $ (show $ fst $ s) ++ " " ++ (show $ fst $ a))
               go s xs

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.List

main :: IO ()
main = do
  cases::Int <- read <$> getLine
  forM_ [1..cases] (\cn -> do
      n::Int <- read <$> getLine
      gang::[Int] <- (map read) <$> words <$> getLine
      let gangs = zip [1..] gang
      if (length $ groupBy (\(_, a) (_, b) -> a == b) $ sortBy (\(_, a) (_, b) -> compare a b) gangs) == 1 then
        putStrLn "NO"
      else do
        let ganged = map (\x -> (head x, length x, x)) $ group $ sort gangs
        let sorted = sortBy (\(_, a, _) (_, b, _) -> compare a b) ganged
        let (a, b, p) = head sorted
        let start_point = head p
        let rest_ganged = tail ganged ++ [(a, b, tail p)]
        putStrLn "YES"
        go start_point rest_ganged
        pure ()
      pure ()
    )
  pure ()
       where go _ [] = pure ()
             go s ((_, _, ls):xs) = do
               forM_ ls $ (\a -> putStrLn $ (show $ fst $ s) ++ " " ++ (show $ fst $ a))
               go s xs


Joe has been hurt on the Internet. Now he is storming around the house, destroying everything in his path.Joe's house has n floors, each floor is a segment of m cells. Each cell either contains nothing (it is an empty cell), or has a brick or a concrete wall (always something one of three). It is believed that each floor is surrounded by a concrete wall on the left and on the right.Now Joe is on the n-th floor and in the first cell, counting from left to right. At each moment of time, Joe has the direction of his gaze, to the right or to the left (always one direction of the two). Initially, Joe looks to the right.Joe moves by a particular algorithm. Every second he makes one of the following actions:   If the cell directly under Joe is empty, then Joe falls down. That is, he moves to this cell, the gaze direction is preserved.  Otherwise consider the next cell in the current direction of the gaze.   If the cell is empty, then Joe moves into it, the gaze direction is preserved.  If this cell has bricks, then Joe breaks them with his forehead (the cell becomes empty), and changes the direction of his gaze to the opposite.  If this cell has a concrete wall, then Joe just changes the direction of his gaze to the opposite (concrete can withstand any number of forehead hits).  Joe calms down as soon as he reaches any cell of the first floor.The figure below shows an example Joe's movements around the house.  Determine how many seconds Joe will need to calm down.

The first line contains two integers n and m (2 ≤ n ≤ 100, 1 ≤ m ≤ 104). Next n lines contain the description of Joe's house. The i-th of these lines contains the description of the (n - i + 1)-th floor of the house — a line that consists of m characters: "." means an empty cell, "+" means bricks and "#" means a concrete wall. It is guaranteed that the first cell of the n-th floor is empty.

Print a single number — the number of seconds Joe needs to reach the first floor; or else, print word "Never" (without the quotes), if it can never happen. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

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

main = do
  [n, m] <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  s <- replicateM n C.getLine
  case solve n m s of
    Nothing -> putStrLn "Never"
    Just ans -> print ans

solve n m s = gao (1, 1, 1, True, 2) (0 :: Int64)
  where
  a = listArray (1, n) $ map (\i -> C.concat [C.pack "#", C.take m i, C.pack "#"]) s
  c i j = C.index (a!i) j
  gao (k, l, r, dir, ttl) ans
    | k >= n           = Just ans
    | c (k+1) p == '.' = gao (k + 1, p, p, dir, 2) $ ans + 1
    | ttl < 0          = Nothing
    | otherwise        =
      case c k q of
        '.' -> gao (k, l', r', dir, 2) $ ans + 1
        '+' -> gao (k, l', r', not dir, 2) $ ans + 1 + fromIntegral (r - l)
        '#' -> gao (k, l, r, not dir, ttl - 1) $ ans + 1 + fromIntegral (r - l)
    where
      (p, q, l', r') = ans `seq`
        if dir
          then (r, r + 1, l, r + 1)
          else (l, l - 1, l - 1, r)

{-
C.take m i  -- '\r'
ans `seq`   --  Runtime error on test 8
-}

import System.IO
import Data.List
import Data.Function(on)

data Dir = DLeft | DRight deriving (Eq)

solve :: [String] -> Int -> Dir -> Maybe Integer
solve (l1:[]) pos _ = Just 0
solve (l1:l2:xs) pos dir
    | (l2!!pos == '.') =
        let v = solve(l2:xs) pos dir
        in case v of Nothing -> Nothing
                     Just x -> Just (1 + x)
    | otherwise = let
                    n = (length l1) - 1
                    (leftPart, _:rightPart) = splitAt pos l2
                    leftPos' = findIndices (=='.') leftPart
                    rightPos' = findIndex (=='.') rightPart
                    leftPos = if (not $ null leftPos') then (last leftPos') else 0
                    rightPos = case rightPos' of
                                    Nothing -> n
                                    Just x -> pos + 1 + x
                    (upLeftPart, _:upRightPart) = splitAt pos l1
                    blockLeft = last $ findIndices (=='#') upLeftPart
                    blockRight = pos + 1 + (head $ findIndices (=='#') upRightPart)
                    leftIndexed = zip upLeftPart [0..]
                    rightIndexed = zipWith (\x y -> (x, y + pos + 1)) upRightPart [0..]
                    in if (blockLeft >= leftPos && blockRight <= rightPos) then Nothing
                       else if blockRight > rightPos && blockLeft >= leftPos then
                            let
                                takeRight = (:) ('.', rightPos + 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                stepsRight = length takeRight
                                stepsLeft = stepsRight - (if dir == DRight then 1 else 0)
                                takeLeft' = take stepsLeft $ filter ((=='+').fst) $ takeWhile (\(x, y) -> x /= '#') $ reverse leftIndexed
                                takeLeft = (replicate (max 0 $ stepsLeft - length takeLeft') ('#', blockLeft)) ++ takeLeft'
                                nextAnswer = solve (l2:xs) rightPos DRight
                                -- nextAnswer = Just 0
                                in
                                -- Just (snd $ head takeRight)
                                -- Just (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight - 2 * (length takeRight) * pos)
                                -- Just ((computeTake takeLeft takeRight pos))
                                -- nextAnswer
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (x + (toInteger $ (computeTake takeLeft takeRight pos) - abs (pos - rightPos) + 1))
                        else if (blockLeft < leftPos && blockRight <= rightPos) then
                            let
                                takeLeft = (:) ('.', leftPos - 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                stepsLeft = length takeLeft
                                stepsRight = stepsLeft - (if dir == DLeft then 1 else 0)
                                takeRight' = take stepsRight $ filter ((=='+').fst) $ takeWhile (\(x, y) -> x /= '#') rightIndexed
                                takeRight = (++) takeRight' $ replicate (max 0 $ stepsRight - length takeRight') ('#', blockRight)
                                nextAnswer = solve (l2:xs) leftPos DLeft
                                in
                                -- Just (length takeRight)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (x + (toInteger $ (computeTake takeLeft takeRight pos) - abs (pos - leftPos) + 1))
                        else
                            let
                                takeLeft' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                takeRight' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                minLength = (min `on` length) takeLeft' takeRight'
                                lengthLeft = length takeLeft'
                                lengthRight = length takeRight'
                                (nextPos, nextDir) = if lengthLeft == lengthRight then
                                                        if dir == DLeft then (leftPos, DLeft)
                                                        else (rightPos, DRight)
                                                     else if lengthLeft < lengthRight then (leftPos, DLeft)
                                                     else (rightPos, DRight)
                                stepsLeft = minLength + (if nextDir == DRight && dir == DLeft then 1 else 0)
                                stepsRight = minLength + (if nextDir == DLeft && dir == DRight then 1 else 0)
                                takeLeft = (if nextDir == DLeft then [('.', leftPos - 1)] else []) ++ (take stepsLeft takeLeft')
                                takeRight = (if nextDir == DRight then [('.', rightPos + 1)] else []) ++ (take stepsRight takeRight')
                                nextAnswer = solve (l2:xs) nextPos nextDir
                                -- nextAnswer = 0
                                in
                                -- Just (if nextDir == DRight then 1 else 0)
                                -- Just (2 * (length takeLeft) * pos - 2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft)
                                -- Just ((computeTake takeLeft takeRight pos)- abs (pos - nextPos) + 1)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (x + (toInteger $ (computeTake takeLeft takeRight pos) - abs (pos - nextPos) + 1))

    where
        computeTake takeLeft takeRight pos =
            let stepsLeft = length takeLeft; stepsRight = length takeRight in
                (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight -
                2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft +
                2 * (stepsLeft - stepsRight) * pos + stepsLeft + stepsRight - 1)

main = do
    firstLine <- getLine
    other <- getContents
    let
        [n, m] = map read $ lines firstLine :: [Int]
        matrix = map (('#':).(++"#")) $ takeWhile (not.null) $ lines other
        in
        -- print $ matrix
        putStrLn $ result $ solve matrix 1 DRight
            where result Nothing = "Never"
                  result (Just x) = show x

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

main = do
  [n, m] <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  s <- replicateM n C.getLine
  case solve n m s of
    Nothing -> putStrLn "Never"
    Just ans -> print ans

solve n m s = gao 1 (1, 1) True 0
  where
  a = listArray (1, n) $ map (\i -> C.concat [C.pack "#", i, C.pack "#"]) s
  c i j = C.index (a!i) j
  gao k (l, r) d t
    | k == n =
      Just t
    | c (k+1) p == '.' =
      gao (k + 1) (p, p) d $ t + 1
    | c k (l-1) == '#' && c k (r+1) == '#' =
      Nothing
    | otherwise        =
      case c k q of
        '.' -> gao k (l', r') d $ t + 1
        '+' -> gao k (l', r') (not d) $ t + 1 + (r - l)
        '#' -> gao k (l, r) (not d) $ t + 1 + (r - l)
    where
      (p, q, l', r') =
        if d
          then (r, r + 1, l, r + 1)
          else (l, l - 1, l - 1, r)

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

main = do
  [n, m] <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  s <- replicateM n C.getLine
  case solve n m s of
    Nothing -> putStrLn "Never"
    Just ans -> print ans

solve n m s = gao 1 (1, 1) True 0
  where
  a = listArray (1, n) $ map (\i -> C.concat [C.pack "#", i, C.pack "#"]) s
  c i j = C.index (a!i) j
  gao k (l, r) d t
    | k == n           = Just t
    | l == 1 && r == m = Nothing
    | c (k+1) p == '.' = gao (k + 1) (p, p) d $ t + 1
    | otherwise        =
      case c k q of
        '.' -> gao k (l', r') d $ t + 1
        '+' -> gao k (l', r') (not d) $ t + 1 + (r - l)
        '#' -> gao k (l, r) (not d) $ t + 1 + (r - l)
    where
      (p, q, l', r') =
        if d
          then (r, r + 1, l, r + 1)
          else (l, l - 1, l - 1, r)

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

main = do
  [n, m] <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  s <- replicateM n C.getLine
  case solve n m s of
    Nothing -> putStrLn "Never"
    Just ans -> print ans

solve n m s = gao (1, 1, 1, True, 2) 0
  where
  a = listArray (1, n) $ map (\i -> C.concat [C.pack "#", C.take m i, C.pack "#"]) s
  c i j = C.index (a!i) j
  gao (k, l, r, dir, ttl) ans
    | l < 1 || r > m   = Nothing
    | k >= n           = Just ans
    | c (k+1) p == '.' = gao (k + 1, p, p, dir, 2) $ ans + 1
    | ttl < 0          = Nothing
    | otherwise        =
      case c k q of
        '.' -> gao (k, l', r', dir, 2) $ ans + 1
        '+' -> gao (k, l', r', not dir, 2) $ ans + 1 + (r - l)
        '#' -> gao (k, l, r, not dir, ttl - 1) $ ans + 1 + (r - l)
    where
      (p, q, l', r') =
        trace (show (k, l, r, dir, ttl, ans)) $
        if dir
          then (r, r + 1, l, r + 1)
          else (l, l - 1, l - 1, r)

import System.IO
import Data.List
import Data.Function(on)

data Dir = DLeft | DRight deriving (Eq)

solve :: [String] -> Int -> Dir -> Maybe Int
solve (l1:[]) pos _ = Just 0
solve (l1:l2:xs) pos dir
    | (l2!!pos == '.') =
        let v = solve(l2:xs) pos dir
        in case v of Nothing -> Nothing
                     Just x -> Just (1 + x)
    | otherwise = let
                    n = (length l1) - 1
                    (leftPart, _:rightPart) = splitAt pos l2
                    leftPos' = findIndices (=='.') leftPart
                    rightPos' = findIndex (=='.') rightPart
                    leftPos = if (not $ null leftPos') then (last leftPos') else 0
                    rightPos = case rightPos' of
                                    Nothing -> n
                                    Just x -> pos + 1 + x
                    (upLeftPart, _:upRightPart) = splitAt pos l1
                    blockLeft = last $ findIndices (=='#') upLeftPart
                    blockRight = pos + 1 + (head $ findIndices (=='#') upRightPart)
                    leftIndexed = zip upLeftPart [0..]
                    rightIndexed = zipWith (\x y -> (x, y + pos + 1)) upRightPart [0..]
                    in if (blockLeft >= leftPos && blockRight <= rightPos) then Nothing
                       else if blockRight > rightPos && blockLeft >= leftPos then
                            let
                                takeRight = (:) ('.', rightPos + 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                stepsRight = length takeRight
                                stepsLeft = stepsRight - (if dir == DRight then 1 else 0)
                                takeLeft' = take stepsLeft $ takeWhile (\(x, y) -> x /= '#') $ reverse leftIndexed
                                takeLeft = (replicate (max 0 $ stepsLeft - length takeLeft') ('#', blockLeft)) ++ takeLeft'
                                nextAnswer = solve (l2:xs) rightPos DRight
                                -- nextAnswer = Just 0
                                in
                                -- Just (snd $ head takeRight)
                                -- Just (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight - 2 * (length takeRight) * pos)
                                -- Just ((computeTake takeLeft takeRight pos))
                                -- nextAnswer
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - rightPos) + 1)
                        else if (blockLeft < leftPos && blockRight <= rightPos) then
                            let
                                takeLeft = (:) ('.', leftPos - 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                stepsLeft = length takeLeft
                                stepsRight = stepsLeft - (if dir == DLeft then 1 else 0)
                                takeRight' = take stepsRight $ takeWhile (\(x, y) -> x /= '#') rightIndexed
                                takeRight = (++) takeRight' $ replicate (max 0 $ stepsRight - length takeRight') ('#', blockRight)
                                nextAnswer = solve (l2:xs) leftPos DLeft
                                in
                                -- Just (length takeRight)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - leftPos) + 1)
                        else
                            let
                                takeLeft' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                takeRight' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                minLength = (min `on` length) takeLeft' takeRight'
                                lengthLeft = length takeLeft'
                                lengthRight = length takeRight'
                                (nextPos, nextDir) = if lengthLeft == lengthRight then
                                                        if dir == DLeft then (leftPos, DLeft)
                                                        else (rightPos, DRight)
                                                     else if lengthLeft < lengthRight then (leftPos, DLeft)
                                                     else (rightPos, DRight)
                                stepsLeft = minLength + (if nextDir == DRight && dir == DLeft then 1 else 0)
                                stepsRight = minLength + (if nextDir == DLeft && dir == DRight then 1 else 0)
                                takeLeft = (if nextDir == DLeft then [('.', leftPos - 1)] else []) ++ (take stepsLeft takeLeft')
                                takeRight = (if nextDir == DRight then [('.', rightPos + 1)] else []) ++ (take stepsRight takeRight')
                                nextAnswer = solve (l2:xs) nextPos nextDir
                                -- nextAnswer = 0
                                in
                                -- Just (if nextDir == DRight then 1 else 0)
                                -- Just (2 * (length takeLeft) * pos - 2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft)
                                -- Just ((computeTake takeLeft takeRight pos)- abs (pos - nextPos) + 1)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - nextPos) + 1)

    where computeTake takeLeft takeRight pos =
            let stepsLeft = length takeLeft; stepsRight = length takeRight in
                (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight -
                2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft +
                2 * (stepsLeft - stepsRight) * pos + stepsLeft + stepsRight - 1)

main = do
    firstLine <- getLine
    other <- getContents
    let
        [n, m] = map read $ lines firstLine :: [Int]
        matrix = map (('#':).(++"#")) $ takeWhile (not.null) $ lines other
        in
        -- print $ matrix
        putStrLn $ result $ solve matrix 1 DRight
            where result Nothing = "Never"
                  result (Just x) = show x

import System.IO
import Data.List
import Data.Function(on)

data Dir = DLeft | DRight deriving (Eq)

solve :: [String] -> Int -> Dir -> Maybe Int
solve (l1:[]) pos _ = Just 0
solve (l1:l2:xs) pos dir
    | (l2!!pos == '.') =
        let v = solve(l2:xs) pos dir
        in case v of Nothing -> Nothing
                     Just x -> Just (1 + x)
    | otherwise = let
                    n = (length l1) - 1
                    (leftPart, _:rightPart) = splitAt pos l2
                    leftPos' = findIndices (=='.') leftPart
                    rightPos' = findIndex (=='.') rightPart
                    leftPos = if (not $ null leftPos') then (last leftPos') else 0
                    rightPos = case rightPos' of
                                    Nothing -> n
                                    Just x -> pos + 1 + x
                    (upLeftPart, _:upRightPart) = splitAt pos l1
                    blockLeft = last $ findIndices (=='#') upLeftPart
                    blockRight = pos + 1 + (head $ findIndices (=='#') upRightPart)
                    leftIndexed = zip upLeftPart [0..]
                    rightIndexed = zipWith (\x y -> (x, y + pos + 1)) upRightPart [0..]
                    in if (blockLeft >= leftPos && blockRight <= rightPos) then Nothing
                       else if blockRight > rightPos && blockLeft >= leftPos then
                            let
                                takeRight = (:) ('.', rightPos + 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                stepsRight = length takeRight
                                stepsLeft = stepsRight - (if dir == DRight then 1 else 0)
                                takeLeft' = take stepsLeft $ filter ((=='+').fst) $ takeWhile (\(x, y) -> x /= '#') $ reverse leftIndexed
                                takeLeft = (replicate (max 0 $ stepsLeft - length takeLeft') ('#', blockLeft)) ++ takeLeft'
                                nextAnswer = solve (l2:xs) rightPos DRight
                                -- nextAnswer = Just 0
                                in
                                -- Just (snd $ head takeRight)
                                -- Just (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight - 2 * (length takeRight) * pos)
                                -- Just ((computeTake takeLeft takeRight pos))
                                -- nextAnswer
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - rightPos) + 1)
                        else if (blockLeft < leftPos && blockRight <= rightPos) then
                            let
                                takeLeft = (:) ('.', leftPos - 1) $ filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                stepsLeft = length takeLeft
                                stepsRight = stepsLeft - (if dir == DLeft then 1 else 0)
                                takeRight' = take stepsRight $ filter ((=='+').fst) $ takeWhile (\(x, y) -> x /= '#') rightIndexed
                                takeRight = (++) takeRight' $ replicate (max 0 $ stepsRight - length takeRight') ('#', blockRight)
                                nextAnswer = solve (l2:xs) leftPos DLeft
                                in
                                -- Just (length takeRight)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - leftPos) + 1)
                        else
                            let
                                takeLeft' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y >= leftPos) $ reverse leftIndexed
                                takeRight' = filter ((=='+').fst) $ takeWhile (\(x, y) -> y <= rightPos) rightIndexed
                                minLength = (min `on` length) takeLeft' takeRight'
                                lengthLeft = length takeLeft'
                                lengthRight = length takeRight'
                                (nextPos, nextDir) = if lengthLeft == lengthRight then
                                                        if dir == DLeft then (leftPos, DLeft)
                                                        else (rightPos, DRight)
                                                     else if lengthLeft < lengthRight then (leftPos, DLeft)
                                                     else (rightPos, DRight)
                                stepsLeft = minLength + (if nextDir == DRight && dir == DLeft then 1 else 0)
                                stepsRight = minLength + (if nextDir == DLeft && dir == DRight then 1 else 0)
                                takeLeft = (if nextDir == DLeft then [('.', leftPos - 1)] else []) ++ (take stepsLeft takeLeft')
                                takeRight = (if nextDir == DRight then [('.', rightPos + 1)] else []) ++ (take stepsRight takeRight')
                                nextAnswer = solve (l2:xs) nextPos nextDir
                                -- nextAnswer = 0
                                in
                                -- Just (if nextDir == DRight then 1 else 0)
                                -- Just (2 * (length takeLeft) * pos - 2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft)
                                -- Just ((computeTake takeLeft takeRight pos)- abs (pos - nextPos) + 1)
                                case nextAnswer of
                                    Nothing -> Nothing
                                    (Just x) -> Just (((+) x $ computeTake takeLeft takeRight pos) - abs (pos - nextPos) + 1)

    where computeTake takeLeft takeRight pos =
            let stepsLeft = length takeLeft; stepsRight = length takeRight in
                (2 * foldl (\s (x, y) -> s + y - 1) 0 takeRight -
                2 * foldl (\s (x, y) -> s + y + 1) 0 takeLeft +
                2 * (stepsLeft - stepsRight) * pos + stepsLeft + stepsRight - 1)

main = do
    firstLine <- getLine
    other <- getContents
    let
        [n, m] = map read $ lines firstLine :: [Int]
        matrix = map (('#':).(++"#")) $ takeWhile (not.null) $ lines other
        in
        -- print $ matrix
        putStrLn $ result $ solve matrix 1 DRight
            where result Nothing = "Never"
                  result (Just x) = show x


You have an array $$$a$$$ of size $$$n$$$ consisting only of zeroes and ones and an integer $$$k$$$. In one operation you can do one of the following:  Select $$$2$$$ consecutive elements of $$$a$$$ and replace them with their minimum (that is, let $$$a := [a_{1}, a_{2}, \ldots, a_{i-1}, \min(a_{i}, a_{i+1}), a_{i+2}, \ldots, a_{n}]$$$ for some $$$1 \le i \le n-1$$$). This operation decreases the size of $$$a$$$ by $$$1$$$.  Select $$$k$$$ consecutive elements of $$$a$$$ and replace them with their maximum (that is, let $$$a := [a_{1}, a_{2}, \ldots, a_{i-1}, \max(a_{i}, a_{i+1}, \ldots, a_{i+k-1}), a_{i+k}, \ldots, a_{n}]$$$ for some $$$1 \le i \le n-k+1$$$). This operation decreases the size of $$$a$$$ by $$$k-1$$$. Determine if it's possible to turn $$$a$$$ into $$$[1]$$$ after several (possibly zero) operations.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le k \le n \le 50$$$), the size of array $$$a$$$ and the length of segments that you can perform second type operation on. The second line contains $$$n$$$ integers $$$a_{1}, a_{2}, \ldots, a_{n}$$$ ($$$a_i$$$ is $$$0$$$ or $$$1$$$), elements of array $$$a$$$.

For each test case, if it is possible to turn $$$a$$$ into $$$[1]$$$, print "YES", otherwise print "NO".

NoteIn the first test case, you can perform the second type operation on second and third elements so $$$a$$$ becomes $$$[0, 1]$$$, then you can perform the second type operation on first and second elements, so $$$a$$$ turns to $$$[1]$$$.In the fourth test case, it's obvious to see that you can't make any $$$1$$$, no matter what you do.In the fifth test case, you can first perform a type 2 operation on the first three elements so that $$$a$$$ becomes $$$[1, 0, 0, 1]$$$, then perform a type 2 operation on the elements in positions two through four, so that $$$a$$$ becomes $$$[1, 1]$$$, and finally perform the first type operation on the remaining elements, so that $$$a$$$ becomes $$$[1]$$$.

import Control.Monad
main = do
    tt <- getLine
    replicateM (read tt) $ do
        getLine
        as <- getLine
        putStrLn $ if elem '1' as then "YES" else "NO"

import Control.Monad
main = do
    tt <- getLine
    replicateM (read tt) $ do
        as <- getLine
        putStrLn $ if elem '1' as then "YES" else "NO"


As some of you know, cubism is a trend in art, where the problem of constructing volumetrical shape on a plane with a combination of three-dimensional geometric shapes comes to the fore. A famous sculptor Cicasso, whose self-portrait you can contemplate, hates cubism. He is more impressed by the idea to transmit two-dimensional objects through three-dimensional objects by using his magnificent sculptures. And his new project is connected with this. Cicasso wants to make a coat for the haters of anticubism. To do this, he wants to create a sculpture depicting a well-known geometric primitive — convex polygon.Cicasso prepared for this a few blanks, which are rods with integer lengths, and now he wants to bring them together. The i-th rod is a segment of length li.The sculptor plans to make a convex polygon with a nonzero area, using all rods he has as its sides. Each rod should be used as a side to its full length. It is forbidden to cut, break or bend rods. However, two sides may form a straight angle .Cicasso knows that it is impossible to make a convex polygon with a nonzero area out of the rods with the lengths which he had chosen. Cicasso does not want to leave the unused rods, so the sculptor decides to make another rod-blank with an integer length so that his problem is solvable. Of course, he wants to make it as short as possible, because the materials are expensive, and it is improper deed to spend money for nothing. Help sculptor!

The first line contains an integer n (3 ≤ n ≤ 105) — a number of rod-blanks. The second line contains n integers li (1 ≤ li ≤ 109) — lengths of rods, which Cicasso already has. It is guaranteed that it is impossible to make a polygon with n vertices and nonzero area using the rods Cicasso already has.

Print the only integer z — the minimum length of the rod, so that after adding it it can be possible to construct convex polygon with (n + 1) vertices and nonzero area from all of the rods.

NoteIn the first example triangle with sides {1 + 1 = 2, 2, 1} can be formed from a set of lengths {1, 1, 1, 2}. In the second example you can make a triangle with lengths {20, 11, 4 + 3 + 2 + 1 = 10}.

module Main where

import Data.List
import Data.Ord
import Data.Maybe

main :: IO ()
main = do
	getLine
	getInts >>= (print . fromJust . minFix)

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

type CounterExample a = (a, [a])

-- Lists with at most two members are bad

-- Any list with at least three elements can have at most one counterexample; and that, if any, is always the maximum member of the list

-- A good list cannot be spoiled by a new member that is less than its sum

minFix :: (Num a, Ord a, Enum a) => [a] -> Maybe a
minFix  = safe minFix0

minFix0 :: (Num a, Ord a, Enum a) => a -> [a] -> Maybe a
minFix0 = fmap mend .-. counterExample
--minFix0 a as = fmap mend $ counterExample a as

safe, safe0 :: Ord a => (a -> [a] -> Maybe b) -> [a] -> Maybe b
safe  f            = safe0 f . sortDesc
safe0 f (x:y:more) = f x (y:more)
safe0 _ _          = Nothing

counterExample :: (Ord a, Num a) => a -> [a] -> Maybe (CounterExample a)
counterExample a as = if a < sum as
    then Nothing
    else Just (a, as)

mend :: (Num a, Ord a, Enum a) => CounterExample a -> a
mend (a, as) = succ $ a - sum as

sortDesc :: Ord a => [a] -> [a]
sortDesc = reverse . sort -- sortBy (rev compare)

(.-.) :: (c -> d) -> (a ->b -> c) -> a -> b -> d
(f .-. g) x y = f $ g x y

import Data.List

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

solve :: [Int] -> Int
solve a = maximum a * 2 - sum a + 1

import Data.List

main = do
  _ <- getLine
  inp <- fmap (map read . words) getLine
  print (solve inp)

solve :: [Int] -> Int
solve ls = 2*maximum ls + 1 - sum ls

main = do
		n <- getLine
		c <- getLine
		let a = (map (\x -> read x :: Integer) .words) c
		--print (foldr (max) (-1) a)
		print $ max (2 * (foldr (max) (-1) a) - (foldr (+) (0) a) + 1) 1

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.UArray
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  n <- readInt641 <$> BS.getLine
  ns <- readInt64N <$> BS.getLine
  print $ solve ns

solve :: [Int64] -> Int64
solve ns = 2 * maximum ns - sum ns + 1

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] =(x, y, z)

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

fromTriple :: (a, a, a) -> [a]
fromTriple (x, y, z) = [x, y, z]

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

main = do
	n <- getLine
	input <- getLine
	let ls = map (read::String->Int) $ words input
	putStrLn $ show $ 2 * maximum ls - sum ls + 1

main = do
    _ <- getLine
    s <- getLine
    let l = map read . words $ s
        m = maximum l
        rest = sum l - m
    print $ m - rest + 1

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: [Integer] -> Integer
solve rods = delta $ foldr f (0,0) (sort rods)
  where f :: Integer -> (Integer,Integer) -> (Integer,Integer)
        f x (a,b) | a < b     = (a+x,b)
                  | otherwise = (a,b+x)
        delta :: (Integer,Integer) -> Integer
        delta (a,b) = 1 + abs (a - b)

main :: IO ()
main = do
  _ <- getLine
  rodsStr <- getLine
  let rods = map read (words rodsStr) :: [Integer]
  putStrLn $ show (solve rods)

main = do
	n <- getLine
	input <- getLine
	let ls = map (read::String->Int) $ words input
	putStrLn $ show $ sum ls - maximum ls * 2 + 1


Let's call an array of $$$k$$$ integers $$$c_1, c_2, \ldots, c_k$$$ terrible, if the following condition holds:Let $$$AVG$$$ be the $$$\frac{c_1 + c_2 + \ldots + c_k}{k}$$$(the average of all the elements of the array, it doesn't have to be integer). Then the number of elements of the array which are bigger than $$$AVG$$$ should be strictly larger than the number of elements of the array which are smaller than $$$AVG$$$. Note that elements equal to $$$AVG$$$ don't count.For example $$$c = \{1, 4, 4, 5, 6\}$$$ is terrible because $$$AVG = 4.0$$$ and $$$5$$$-th and $$$4$$$-th elements are greater than $$$AVG$$$ and $$$1$$$-st element is smaller than $$$AVG$$$.Let's call an array of $$$m$$$ integers $$$b_1, b_2, \ldots, b_m$$$ bad, if at least one of its non-empty subsequences is terrible, and good otherwise.You are given an array of $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$. Find the minimum number of elements that you have to delete from it to obtain a good array.An array is a subsequence of another array if it can be obtained from it by deletion of several (possibly, zero or all) elements.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the size of $$$a$$$. The second line of each testcase contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — elements of array $$$a$$$. In each testcase for any $$$1 \le i \lt n$$$ it is guaranteed that $$$a_i \le a_{i+1}$$$. It is guaranteed that the sum of $$$n$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print the minimum number of elements that you have to delete from it to obtain a good array.

NoteIn the first sample, the array $$$a$$$ is already good.In the second sample, it's enough to delete $$$1$$$, obtaining array $$$[4, 4, 5, 6]$$$, which is good.

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

binSearch :: (Int -> Bool) -> Int -> Int -> Int
{-# INLINE binSearch #-}
binSearch fun = let
  go !li !ri = if  li == ri
    then  li
    else  let
    mi = li + div (ri - li) 2
    in  if  fun mi
    then  go li mi
    else  go (mi + 1) ri
  in  go

lowerBound :: UArray Int Int -> Int -> Int
lowerBound !arr !t = let
  (p, q) = bounds arr
  in  binSearch (\i -> arr ! i >= t) p (q + 1)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- listArray (1, n) <$> getInts n
    let
      score i = let
        v0 = a ! i
        j1 = lowerBound a (v0 + 1)
        go !acc !j = if  j > n
          then  acc
          else  go (acc + 1) (lowerBound a $ 2 * a ! j - v0)
        in  go (j1 - i) j1
      ans = foldl' max 0 $ map score [1 .. n]
    pure $ putInts [n - ans]

type SP = State [P.ByteString]

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

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

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

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


You are given a string $$$s$$$ consisting of the characters 0, 1, and ?.Let's call a string unstable if it consists of the characters 0 and 1 and any two adjacent characters are different (i. e. it has the form 010101... or 101010...).Let's call a string beautiful if it consists of the characters 0, 1, and ?, and you can replace the characters ? to 0 or 1 (for each character, the choice is independent), so that the string becomes unstable.For example, the strings 0??10, 0, and ??? are beautiful, and the strings 00 and ?1??1 are not.Calculate the number of beautiful contiguous substrings of the string $$$s$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — number of test cases. The first and only line of each test case contains the string $$$s$$$ ($$$1 \le |s| \le 2 \cdot 10^5$$$) consisting of characters 0, 1, and ?. It is guaranteed that the sum of the string lengths over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the number of beautiful substrings of the string $$$s$$$.

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

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

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

solve :: String -> Int64 -> (Int64, Int64) -> Int64
solve [] _ _ = 0
solve ('?':cs) i x@(x0,x1) = i - (x0 `min` x1) + solve cs (i+1) x
solve (c:cs) i (x0,x1)
    | ord c - ord '0' == fromIntegral i `mod` 2 =
        i - x1 + solve cs (i+1) (i,x1)
    | otherwise =
        i - x0 + solve cs (i+1) (x0,i)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        cs <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
        print $ solve cs 0 (-1,-1)

import Control.Monad
import Data.Maybe
import Data.Char
import Data.Int
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
    s <- filter (not . isSpace) . C.unpack <$> C.getLine
    let func [] = (0 :: Int64, 0, -1, 0)
        func (x : xs)
          | x == '0' || x == '1' =
              case digitToInt x /= h of
                True -> (total + 1 + l + c, 0, digitToInt x, 1 + l + c)
                False -> (total + 1 + l, 0, digitToInt x, 1 + l)
          | otherwise = (total + 1 + l + c, l + 1, if h == -1 then -1 else 1 - h, c)
          where (total, l, h, c) = func xs
        (result, _, _, _) = func s
    return $ int64Dec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad
import Data.Int
import Data.List

solve :: IO ()
solve = do
    s <- getLine
    let f (lst, d, lstV, t) cur
            | cur == '?'            = (lst, d + 1, lstV,     t + lstV + d)
            | (lst == cur) /= odd d = (cur, 1,     lstV + d, t + lstV + d)
            | otherwise             = (cur, 1,     d,        t + d)
    print $ let (_, _, _, t) = foldl' f (head s, 1, 0, 0 :: Int64) s in t

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Data.List (group)

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

solve :: String -> Integer
solve s = compute "01" s + compute "10" s - compute "?" s

compute :: String -> String -> Integer
compute st = sum . map (count  . length) . filter head . group . zipWith match (concat (repeat st))
  where
    match _ '?' = True
    match a b = a == b

count :: Int -> Integer
count n = let n' = toInteger n in (n' * (n' + 1)) `div` 2

{-# 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
	s <- getLine
	let
		match01 :: Integer = solve' match s $ cycle "01"
		match10 = solve' match s $ cycle "10"
		match_q = solve' (==) s $ repeat '?'
	print $ match01 + match10 - match_q

solve' m s t = sum $ map ( f . fromIntegral . length ) $ filter head $ group $ zipWith m s t
	where
		f x = x + x * ( x - 1 ) `div` 2

match _ '?' = True
match '?' _ = True
match c1 c2 = c1 == c2

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

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

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

solve :: String -> Int64 -> (Int64, Int64) -> Int64
solve [] _ _ = 0
solve ('?':cs) i x@(x0,x1) = i - (x0 `min` x1) + solve cs (i+1) x
solve (c:cs) i (x0,x1)
    | ord c - ord '0' == fromIntegral i `mod` 2 =
        i - x1 + solve cs (i+1) (i,x1)
    | otherwise =
        i - x0 + solve cs (i+1) (x0,i)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        cs <- BS.unpack <$> BS.getLine
        print $ solve cs 0 (-1,-1)

import Control.Monad
import Data.Maybe
import Data.Char
import Data.Int
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
    s <- filter (not . isSpace) . C.unpack <$> C.getLine
    let func [] = (0 :: Int64, 0, -1, 0)
        func (x : xs)
          | x == '0' || x == '1' = (total + if f then c' else 1 + l, 0, digitToInt x, c')
          | otherwise = (total + l + 1 + c, l + 1, if h == -1 then -1 else 1 - h, c)
          where (total, l, h, c) = func xs
                f = x == '?' || h == -1 || digitToInt x /= h
                c' = if not f then 1 else 1 + l + c
        (result, _, _, _) = func s
    return $ int64Dec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad
import Data.Maybe
import Data.Char
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
    s <- filter (not . isSpace) . C.unpack <$> C.getLine
    let func [] = (0, 0, -1, 0)
        func (x : xs)
          | x == '0' || x == '1' = (total + if f then c' else 1 + l, 0, digitToInt x, c')
          | otherwise = (total + l + 1 + c, l + 1, if h == -1 then -1 else 1 - h, c)
          where (total, l, h, c) = func xs
                f = x == '?' || h == -1 || digitToInt x /= h
                c' = if not f then 1 else 1 + l + c
        (result, _, _, _) = func s
    return $ int64Dec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output


So you decided to hold a contest on Codeforces. You prepared the problems: statements, solutions, checkers, validators, tests... Suddenly, your coordinator asks you to change all your tests to multiple testcases in the easiest problem!Initially, each test in that problem is just an array. The maximum size of an array is $$$k$$$. For simplicity, the contents of arrays don't matter. You have $$$n$$$ tests — the $$$i$$$-th test is an array of size $$$m_i$$$ ($$$1 \le m_i \le k$$$).Your coordinator asks you to distribute all of your arrays into multiple testcases. Each testcase can include multiple arrays. However, each testcase should include no more than $$$c_1$$$ arrays of size greater than or equal to $$$1$$$ ($$$\ge 1$$$), no more than $$$c_2$$$ arrays of size greater than or equal to $$$2$$$, $$$\dots$$$, no more than $$$c_k$$$ arrays of size greater than or equal to $$$k$$$. Also, $$$c_1 \ge c_2 \ge \dots \ge c_k$$$.So now your goal is to create the new testcases in such a way that:   each of the initial arrays appears in exactly one testcase;  for each testcase the given conditions hold;  the number of testcases is minimum possible. Print the minimum possible number of testcases you can achieve and the sizes of arrays included in each testcase.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 2 \cdot 10^5$$$) — the number of initial tests and the limit for the size of each array. The second line contains $$$n$$$ integers $$$m_1, m_2, \dots, m_n$$$ ($$$1 \le m_i \le k$$$) — the sizes of the arrays in the original tests. The third line contains $$$k$$$ integers $$$c_1, c_2, \dots, c_k$$$ ($$$n \ge c_1 \ge c_2 \ge \dots \ge c_k \ge 1$$$); $$$c_i$$$ is the maximum number of arrays of size greater than or equal to $$$i$$$ you can have in a single testcase.

In the first line print a single integer $$$ans$$$ ($$$1 \le ans \le n$$$) — the minimum number of testcases you can achieve. Each of the next $$$ans$$$ lines should contain the description of a testcase in the following format: $$$t$$$ $$$a_1$$$ $$$a_2$$$ $$$\dots$$$ $$$a_{t}$$$ ($$$1 \le t\le n$$$) — the testcase includes $$$t$$$ arrays, $$$a_i$$$ is the size of the $$$i$$$-th array in that testcase. Each of the initial arrays should appear in exactly one testcase. In particular, it implies that the sum of $$$t$$$ over all $$$ans$$$ testcases should be equal to $$$n$$$. Note that the answer always exists due to $$$c_k \ge 1$$$ (and therefore $$$c_1 \ge 1$$$). If there are multiple answers, you can output any one of them.

NoteIn the first example there is no way to distribute the tests into less than $$$3$$$ testcases. The given answer satisfies the conditions: each of the testcases includes no more than $$$4$$$ arrays of size greater than or equal to $$$1$$$ and no more than $$$1$$$ array of sizes greater than or equal to $$$2$$$ and $$$3$$$.Note that there are multiple valid answers for this test. For example, testcases with sizes $$$[[2], [1, 2], [3]]$$$ would also be correct.However, testcases with sizes $$$[[1, 2], [2, 3]]$$$ would be incorrect because there are $$$2$$$ arrays of size greater than or equal to $$$2$$$ in the second testcase.Note the difference between the third and the fourth examples. You can include up to $$$5$$$ arrays of size greater than or equal to $$$1$$$ in the third example, so you can put all arrays into a single testcase. And you can have only up to $$$1$$$ array in the fourth example. Thus, every array should be included in a separate testcase.

import qualified Data.List as L
import qualified Data.Array as A
import Data.Char
import Data.Maybe

import qualified Data.ByteString.Char8 as B
-- import qualified Debug.Trace as DT

readI :: B.ByteString -> Int
readI = fst . fromJust . B.readInt

format_ans :: [[Int]] -> [String]
format_ans xx = map (unwords . map show) $ ss
  where ss = [[length xx]] ++ (map (\x -> (length x):x) xx)

reallysolve ans a = map (\offset -> map (\i -> 1 + a A.! i) [offset,offset+ans..(length a)-1]) [0..ans-1]

is_good b (i,v)
  | x < i = False
  | otherwise = True
  where x = b A.! v

is_solvable ans a b = L.all (is_good b) ziped
-- is_solvable ans a b = DT.traceShow (ans,ziped) $ L.all (is_good b) ziped
  where inds = [0,ans..(length a)-1]
        vals = map (a A.!) inds
        ziped = zip [1..] vals

binsearch impossible possible a b
  | impossible+1 == possible = reallysolve possible a
  | is_solvable m a b = binsearch impossible m a b
  | otherwise = binsearch m possible a b
  where m = (impossible + possible) `div` 2

solve :: [[Int]] -> [[Int]]
solve [a,b] = binsearch 0 (length a) aa bb
  where aa = A.listArray (0,(length a)-1) (map pred $ reverse $ L.sort a)
        bb = A.listArray (0,(length b)-1) b
-- solve q = DT.traceShow q $ undefined

main = interact $ unlines . format_ans . solve . map (map read . words) . take 2 . tail . lines


Consider a hallway, which can be represented as the matrix with $$$2$$$ rows and $$$n$$$ columns. Let's denote the cell on the intersection of the $$$i$$$-th row and the $$$j$$$-th column as $$$(i, j)$$$. The distance between the cells $$$(i_1, j_1)$$$ and $$$(i_2, j_2)$$$ is $$$|i_1 - i_2| + |j_1 - j_2|$$$.There is a cleaning robot in the cell $$$(1, 1)$$$. Some cells of the hallway are clean, other cells are dirty (the cell with the robot is clean). You want to clean the hallway, so you are going to launch the robot to do this.After the robot is launched, it works as follows. While at least one cell is dirty, the robot chooses the closest (to its current cell) cell among those which are dirty, moves there and cleans it (so the cell is no longer dirty). After cleaning a cell, the robot again finds the closest dirty cell to its current cell, and so on. This process repeats until the whole hallway is clean.However, there is a critical bug in the robot's program. If at some moment, there are multiple closest (to the robot's current position) dirty cells, the robot malfunctions.You want to clean the hallway in such a way that the robot doesn't malfunction. Before launching the robot, you can clean some (possibly zero) of the dirty cells yourself. However, you don't want to do too much dirty work yourself while you have this nice, smart (yet buggy) robot to do this. Note that you cannot make a clean cell dirty.Calculate the maximum possible number of cells you can leave dirty before launching the robot, so that it doesn't malfunction.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of columns in the hallway. Then two lines follow, denoting the $$$1$$$-st and the $$$2$$$-nd row of the hallway. These lines contain $$$n$$$ characters each, where 0 denotes a clean cell and 1 denotes a dirty cell. The starting cell of the robot $$$(1, 1)$$$ is clean.

Print one integer — the maximum possible number of cells you can leave dirty before launching the robot, so that it doesn't malfunction.

NoteIn the first example, you can clean the cell $$$(1, 2)$$$, so the path of the robot is $$$(1, 1) \rightarrow (2, 1) \rightarrow (2, 2)$$$.In the second example, you can leave the hallway as it is, so the path of the robot is $$$(1, 1) \rightarrow (1, 2) \rightarrow (2, 2)$$$.In the third example, you can clean the cell $$$(1, 2)$$$, so the path of the robot is $$$(1, 1) \rightarrow (2, 1) \rightarrow (2, 3) \rightarrow (2, 4) \rightarrow (1, 4)$$$.In the fourth example, the hallway is already clean. Maybe you have launched the robot earlier?

import Control.Monad
import Data.Char (digitToInt)

solve (a,b) (da,db,das,dbs)
                            | a+b==0 = (das,dbs,das,dbs)
                            | a+b==2 = (1+das,1+dbs,max (2+db) (1+das),max (2+da) (1+dbs))
                            | a==1 = (das+1,dbs,das+1,max (da+1) dbs)
                            | b==1 = (das,dbs+1,max (db+1) das,dbs+1)

main :: IO ()
main = do
    input <- getLine
    let n = read  input ::Int
    input <- getLine
    let s1 = map digitToInt input
    input <- getLine
    let s2 = map digitToInt input

    putStrLn.show .(\(_,_,a,_) -> a) $ foldr solve (0,0,0,0) (zip s1 s2)


You have n devices that you want to use simultaneously.The i-th device uses ai units of power per second. This usage is continuous. That is, in λ seconds, the device will use λ·ai units of power. The i-th device currently has bi units of power stored. All devices can store an arbitrary amount of power.You have a single charger that can plug to any single device. The charger will add p units of power per second to a device. This charging is continuous. That is, if you plug in a device for λ seconds, it will gain λ·p units of power. You can switch which device is charging at any arbitrary unit of time (including real numbers), and the time it takes to switch is negligible.You are wondering, what is the maximum amount of time you can use the devices until one of them hits 0 units of power.If you can use the devices indefinitely, print -1. Otherwise, print the maximum amount of time before any one device hits 0 power.

The first line contains two integers, n and p (1 ≤ n ≤ 100 000, 1 ≤ p ≤ 109) — the number of devices and the power of the charger. This is followed by n lines which contain two integers each. Line i contains the integers ai and bi (1 ≤ ai, bi ≤ 100 000) — the power of the device and the amount of power stored in the device in the beginning.

If you can use the devices indefinitely, print -1. Otherwise, print the maximum amount of time before any one device hits 0 power. Your answer will be considered correct if its absolute or relative error does not exceed 10 - 4. Namely, let's assume that your answer is a and the answer of the jury is b. The checker program will consider your answer correct if .

NoteIn sample test 1, you can charge the first device for the entire time until it hits zero power. The second device has enough power to last this time without being charged.In sample test 2, you can use the device indefinitely.In sample test 3, we can charge the third device for 2 / 5 of a second, then switch to charge the second device for a 1 / 10 of a second.

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

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInteger, words, lines)
import qualified Data.Maybe as M (fromJust)
import Data.Ratio ((%), numerator, denominator)

readInt = fst. M.fromJust . C.readInteger
mp [a, b] = (a, b)

test _ _ p tn td amt | amt > p * tn = False
test (a:as) (b:bs) p tn td amt | v > 0 = test as bs p tn td (amt + v) | otherwise = test as bs p tn td amt
    where v = a * tn - b * td
test [] [] _ _ _ _ = True

run as bs p a b | b - a < 1 % 20000 || b - a < a * (1 % 20000) = ans
                | test as bs p mn md 0 = run as bs p m b
                | otherwise = run as bs p a m where
    m = (a + b) / (2 % 1)
    (mn, md) = (numerator m, denominator m)
    ans = fromIntegral (numerator b) / fromIntegral (denominator b)

main = do
    (map readInt . C.words -> [n, p]) <- B.getLine
    (map (mp . map readInt . C.words) . C.lines -> xs) <- B.getContents
    let as = map fst xs
        bs = map snd xs
        (suma, sumb) = (sum as, sum bs)
    putStrLn $ if suma <= p then "-1" else show $ run as bs p (0 % 1) ((sumb % 1) / ((suma - p) % 1) + 10 % 1)


Connected undirected graph without cycles is called a tree. Trees is a class of graphs which is interesting not only for people, but for ants too.An ant stands at the root of some tree. He sees that there are n vertexes in the tree, and they are connected by n - 1 edges so that there is a path between any pair of vertexes. A leaf is a distinct from root vertex, which is connected with exactly one other vertex.The ant wants to visit every vertex in the tree and return to the root, passing every edge twice. In addition, he wants to visit the leaves in a specific order. You are to find some possible route of the ant.

The first line contains integer n (3 ≤ n ≤ 300) — amount of vertexes in the tree. Next n - 1 lines describe edges. Each edge is described with two integers — indexes of vertexes which it connects. Each edge can be passed in any direction. Vertexes are numbered starting from 1. The root of the tree has number 1. The last line contains k integers, where k is amount of leaves in the tree. These numbers describe the order in which the leaves should be visited. It is guaranteed that each leaf appears in this order exactly once.

If the required route doesn't exist, output -1. Otherwise, output 2n - 1 numbers, describing the route. Every time the ant comes to a vertex, output it's index.

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

getA = fmap (map read . words) getLine

main = do
	[n] <- getA
	e <- replicateM (n - 1) getA
	o <- getA
	putStr $ gao n o $ accumArray (flip (:)) [] (1, n) $ concat [[(a, b), (b, a)] | [a, b] <- e]

gao n o e = if fst x <= snd x then unwords (map show y) else "-1" where
	(x, y) = tr 1 0
	tr v p =
		if null w then
			((q, q), [v])
		else if fst $ foldl (\(a,b) (c,d) -> (a && b < c && c <= d, d)) (True, -1) r then
			((fst $ head r, snd $ last r), concat [v:i | i <- s] ++ [v])
		else
			((n, -1), [])
		where
			q = fromJust $ elemIndex v o
			w = filter (/=p) (e!v)
			(r, s) = unzip $ sortBy (\i j -> compare (fst i) (fst j)) $ map (flip tr v) w

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

getA = fmap (map read . words) getLine

main = do
	[n] <- getA
	e <- replicateM (n - 1) getA
	o <- getA
	putStr $ gao n o $ accumArray (flip (:)) [] (1, n) $ concat [[(a, b), (b, a)] | [a, b] <- e]

gao n o e = if fst x <= snd x then unwords (map show y) else "-1" where
	(x, y) = tr 1 0
	tr v p =
		if null w then
			((q, q), [v])
		else if fst $ foldl (\(i,j) k -> (i && j < fst k, snd k)) (True, -1) r then
			((fst $ head r, snd $ last r), concat [v:i | i <- s] ++ [v])
		else
			((n, -1), [])
		where
			q = fromJust $ elemIndex v o
			w = filter (/=p) (e!v)
			(r, s) = unzip $ sortBy (\i j -> compare (fst i) (fst j)) $ map (flip tr v) w


You are given a set of $$$2n+1$$$ integer points on a Cartesian plane. Points are numbered from $$$0$$$ to $$$2n$$$ inclusive. Let $$$P_i$$$ be the $$$i$$$-th point. The $$$x$$$-coordinate of the point $$$P_i$$$ equals $$$i$$$. The $$$y$$$-coordinate of the point $$$P_i$$$ equals zero (initially). Thus, initially $$$P_i=(i,0)$$$.The given points are vertices of a plot of a piecewise function. The $$$j$$$-th piece of the function is the segment $$$P_{j}P_{j + 1}$$$.In one move you can increase the $$$y$$$-coordinate of any point with odd $$$x$$$-coordinate (i.e. such points are $$$P_1, P_3, \dots, P_{2n-1}$$$) by $$$1$$$. Note that the corresponding segments also change.For example, the following plot shows a function for $$$n=3$$$ (i.e. number of points is $$$2\cdot3+1=7$$$) in which we increased the $$$y$$$-coordinate of the point $$$P_1$$$ three times and $$$y$$$-coordinate of the point $$$P_5$$$ one time:  Let the area of the plot be the area below this plot and above the coordinate axis OX. For example, the area of the plot on the picture above is 4 (the light blue area on the picture above is the area of the plot drawn on it).Let the height of the plot be the maximum $$$y$$$-coordinate among all initial points in the plot (i.e. points $$$P_0, P_1, \dots, P_{2n}$$$). The height of the plot on the picture above is 3.Your problem is to say which minimum possible height can have the plot consisting of $$$2n+1$$$ vertices and having an area equal to $$$k$$$. Note that it is unnecessary to minimize the number of moves.It is easy to see that any answer which can be obtained by performing moves described above always exists and is an integer number not exceeding $$$10^{18}$$$.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 10^{18}$$$) — the number of vertices in a plot of a piecewise function and the area we need to obtain.

Print one integer — the minimum possible height of a plot consisting of $$$2n+1$$$ vertices and with an area equals $$$k$$$. It is easy to see that any answer which can be obtained by performing moves described above always exists and is an integer number not exceeding $$$10^{18}$$$.

NoteOne of the possible answers to the first example:  The area of this plot is 3, the height of this plot is 1.There is only one possible answer to the second example:  The area of this plot is 12, the height of this plot is 3.

import Control.Applicative
import Data.Ratio

main = do
  [n,k] <- map read . words <$> getLine :: IO [Integer]
  print $ ceiling (k % n)