Vanya loves playing. He even has a special set of cards to play with. Each card has a single integer. The number on the card can be positive, negative and can even be equal to zero. The only limit is, the number on each card doesn't exceed x in the absolute value.Natasha doesn't like when Vanya spends a long time playing, so she hid all of his cards. Vanya became sad and started looking for the cards but he only found n of them. Vanya loves the balance, so he wants the sum of all numbers on found cards equal to zero. On the other hand, he got very tired of looking for cards. Help the boy and say what is the minimum number of cards does he need to find to make the sum equal to zero?You can assume that initially Vanya had infinitely many cards with each integer number from  - x to x.

The first line contains two integers: n (1 ≤ n ≤ 1000) — the number of found cards and x (1 ≤ x ≤ 1000) — the maximum absolute value of the number on a card. The second line contains n space-separated integers — the numbers on found cards. It is guaranteed that the numbers do not exceed x in their absolute value.

Print a single number — the answer to the problem.

NoteIn the first sample, Vanya needs to find a single card with number -2.In the second sample, Vanya needs to find two cards with number 2. He can't find a single card with the required number as the numbers on the lost cards do not exceed 3 in their absolute value.

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

mp [ a, b ] = ( a, b )

main = do
	[ n, x ] <- map read . words <$> getLine
	s <- abs . sum . map ( read :: String -> Int ) . words <$> getLine
	print $ ( s + x - 1 ) `div` x

main=interact$show.f.map read.words
f(_:x:xs)=(abs(sum xs)+x-1)`div`x

import Control.Applicative
main :: IO ()
main = do
	getInt
	x <- getInt
	total <- (abs . sum . map read . words) <$> getLine
--	putStrLn $ "total is " ++ show total
	print ((total + x - 1) `div` x)

-- Input
getInt :: IO Int
getInt = read <$> nextToken

nextToken :: IO String
nextToken = nextToken' ""

nextToken' :: String -> IO String
nextToken' acc = do
	c <- getChar
	if (c == ' ' || c == '\n') && (acc /= "")
		then return $ reverse acc
	else
		nextToken' (c : acc)

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

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

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

main = do
  [n, x] <- map read . words <$> getLine
  xs <- map read . words <$> getLine

  let
    s = sum xs

  print $ if s > 0 then (s+x-1) `div` x else (-s+x-1) `div` x

main = getContents >>= print . f . map read . tail . words
f (x:y) = div ((abs $ sum y) + x - 1) x

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,x) <- readIntPair
    cs <- readInts
    let y = abs $ sum cs
    print $ div (abs (sum cs) + x-1) x

import Control.Applicative

parseLine = map read . words <$> getLine

main = do
  [_,x] <- parseLine :: IO [Int]
  xs    <- parseLine
  let s = abs $ sum xs
  print $
    if s == 0
    then 0
    else if s <= x
    then 1
    else s `div` x + fromEnum (mod s x /= 0)

import Control.Applicative

parseLine = map read . words <$> getLine

main = do
  [_,x] <- parseLine :: IO [Int]
  xs    <- parseLine
  let s = abs $ sum xs
  print $ s `div` x + fromEnum (mod s x /= 0)

main :: IO ()
main =
  do
    input <- getContents
    putStrLn (show (solve (params input)))

params :: String -> (Int, Int, [Int])
params str =
  let
    toks = words str
  in
    (read (toks !! 0), read (toks !! 1), map read (drop 2 toks))

solve :: (Int, Int, [Int]) -> Int
solve (n, x, list) =
  let
    sum = abs $ foldl (+) 0 list
  in
    1 + ((sum - 1) `div` x)

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

solve :: [[Int]] -> Int
solve [[_, x], xs] = (abs (sum xs) + x - 1) `div` x
solve _ = undefined

main = interact $ show . solve . map read . tail . words
solve (m:cs) = s `div` m + fromEnum (s `mod` m /= 0)
  where s = abs (sum cs)

main = getContents >>= putStrLn . show . (\(n:x:s) -> let mo = abs $ sum $ take n s in (if 0 == mod mo x then 0 else 1) + quot mo x) . map read . words

fuck :: [Int] -> String
fuck (n:x:s) = let
    li = take n s
    mo = abs $ sum li
    in if 0 == mod mo x then show $ quot mo x else show $ 1 + quot mo x

main :: IO ()
main = getContents >>= putStrLn . fuck . map read . words

main = getContents >>= putStrLn . show . (\(n:x:s) -> quot ((abs $ sum s) + x - 1) x) . map read . words

main = do
	s <- getLine
	let t = words s
	let n = read $ head t :: Int
	let x = read $ head $ tail t :: Int
	c <- getLine
	let b = words c
	let a = map read b :: [Int]
	let z = sum a
	let y = ( ( abs z ) + x - 1 ) `div` x
	putStrLn $ show y

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

main=do
	[n,x]<-  map read.words  <$> getLine:: IO  [Int]
	s<- abs.sum.map read. words <$> getLine ::IO Int
	print $ div s x + if (mod s x)>0 then 1 else 0

main = do
  [n, x] <- getLine >>= return. map read. words
  getLine >>= print. (`div` x). (+ (x - 1)). abs. sum. map read. words

import System.IO

main = do
  input1 <- getLine
  input2 <- getLine

  let line1 = words input1
  let line2 = words input2

  let n = read $ head line1 :: Integer
  let x = read $ last line1 :: Integer

  let values = [ read x :: Integer | x <- line2 ]

  let s = abs $ sum values
  let ans = ceiling $ fromIntegral s / fromIntegral x

  print $ ans

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

calc :: [Integer] -> Integer
calc (_:x:xs) = ((abs $ sum xs)+x-1)`div`x

main = interact calc

calc :: String -> String
calc str = show $ ceiling $ s / x
    where x = (read $ head.(drop 1).words $ str)
          s = (abs $ sum $ map read ((drop 2).words $ str))

main = interact $ show . ans . map read . words
ans(_:x:xs) = div (abs(sum xs) + x - 1) x

main = interact$show.f.map read.words
f (_:x:xs) = div (abs(sum xs) + x - 1) x

import Control.Applicative
main :: IO ()
main = do
	x <- getInt
	getInt
	total <- (abs . sum . map read . words) <$> getLine
	print ((total + x - 1) `div` x)

-- Input
getInt :: IO Int
getInt = read <$> nextToken

nextToken :: IO String
nextToken = nextToken' ""

nextToken' :: String -> IO String
nextToken' acc = do
	c <- getChar
	if (c == ' ' || c == '\n') && (acc /= "")
		then return $ reverse acc
	else
		nextToken' (c : acc)

import Control.Applicative

parseLine = map read . words <$> getLine

main = do
  [_,x] <- parseLine :: IO [Int]
  xs    <- parseLine
  let s = sum xs
  print $
    if s == 0
    then 0
    else if abs s <= x
    then 1
    else abs s `div` x + 1

main :: IO ()
main =
  do
    input <- getContents
    putStrLn (show (solve (params input)))

params :: String -> (Int, Int, [Int])
params str =
  let
    toks = words str
  in
    (read (toks !! 0), read (toks !! 1), map read (drop 2 toks))

solve :: (Int, Int, [Int]) -> Int
solve (n, x, list) =
  let
    sum = foldl (+) 0 list
  in
    1 + ((sum - 1) `div` x)

main = getContents >>= putStrLn . show . (\(n:x:s) -> quot ((sum s) + x - 1) x) . map read . words

main = interact calc

calc :: String -> String
calc str = show $ abs $ (sum $ map read ((drop 2).words $ str))`div`(read $ head.(drop 1).words $ str)

main = interact $ show . ans . map read . words
ans(_:x:xs) = abs $ div ((sum xs) + x - 1) x


A sportsman starts from point xstart = 0 and runs to point with coordinate xfinish = m (on a straight line). Also, the sportsman can jump — to jump, he should first take a run of length of not less than s meters (in this case for these s meters his path should have no obstacles), and after that he can jump over a length of not more than d meters. Running and jumping is permitted only in the direction from left to right. He can start andfinish a jump only at the points with integer coordinates in which there are no obstacles. To overcome some obstacle, it is necessary to land at a point which is strictly to the right of this obstacle.On the way of an athlete are n obstacles at coordinates x1, x2, ..., xn. He cannot go over the obstacles, he can only jump over them. Your task is to determine whether the athlete will be able to get to the finish point.

The first line of the input containsd four integers n, m, s and d (1 ≤ n ≤ 200 000, 2 ≤ m ≤ 109, 1 ≤ s, d ≤ 109) — the number of obstacles on the runner's way, the coordinate of the finishing point, the length of running before the jump and the maximum length of the jump, correspondingly. The second line contains a sequence of n integers a1, a2, ..., an (1 ≤ ai ≤ m - 1) — the coordinates of the obstacles. It is guaranteed that the starting and finishing point have no obstacles, also no point can have more than one obstacle, The coordinates of the obstacles are given in an arbitrary order.

If the runner cannot reach the finishing point, print in the first line of the output "IMPOSSIBLE" (without the quotes). If the athlete can get from start to finish, print any way to do this in the following format:   print a line of form "RUN X>" (where "X" should be a positive integer), if the athlete should run for "X" more meters;  print a line of form "JUMP Y" (where "Y" should be a positive integer), if the sportsman starts a jump and should remain in air for "Y" more meters.  All commands "RUN" and "JUMP" should strictly alternate, starting with "RUN", besides, they should be printed chronologically. It is not allowed to jump over the finishing point but it is allowed to land there after a jump. The athlete should stop as soon as he reaches finish.

import Data.Maybe
import Data.List
main = interact $ unlines . reverse . go . map (map read . words) . take 2 . lines
go [[n,m,s,d],al] = chk d $ filter ((s<) . snd) (init sl) ++ [last sl]
   where sl = mk $ sort al++[m+1]
mk l = map (\(x,y) -> (x,y-x-1)) $ zip ((-1):l) l
chk :: Int -> [(Int,Int)] -> [String]
chk d l | l==[] || fst (head l) /= (-1) = [nope]
        | True = fromMaybe [nope] ((foldl' f (Just []) $ zip l (tail l)) >>= \s -> if frl > 0 then Just $ rs frl:s else Just s)
        where frl = (subtract 1) . snd $ last l
              f ms ((x,xl),(y,yl)) | jmp > d = Nothing
                                   | True = ms >>= \s -> Just (js jmp:(rs $ xl-1):s)
                                   where jmp = y-x-xl+1
nope = "IMPOSSIBLE"
js = ("JUMP "++) . show
rs = ("RUN "++) . show


YouKn0wWho has two even integers $$$x$$$ and $$$y$$$. Help him to find an integer $$$n$$$ such that $$$1 \le n \le 2 \cdot 10^{18}$$$ and $$$n \bmod x = y \bmod n$$$. Here, $$$a \bmod b$$$ denotes the remainder of $$$a$$$ after division by $$$b$$$. If there are multiple such integers, output any. It can be shown that such an integer always exists under the given constraints.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$)  — the number of test cases. The first and only line of each test case contains two integers $$$x$$$ and $$$y$$$ ($$$2 \le x, y \le 10^9$$$, both are even).

For each test case, print a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^{18}$$$) that satisfies the condition mentioned in the statement. If there are multiple such integers, output any. It can be shown that such an integer always exists under the given constraints.

NoteIn the first test case, $$$4 \bmod 4 = 8 \bmod 4 = 0$$$.In the second test case, $$$10 \bmod 4 = 2 \bmod 10 = 2$$$.In the third test case, $$$420 \bmod 420 = 420 \bmod 420 = 0$$$.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM_ )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( unfoldr )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue m x = (let V1 (V1 p) = (helper x !*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q) where helper = adjoint . fmap V1

-- eigenvalues m = go [] m
--   where
--     c0 = eigenvector m
--     e0 = eigenvalue m c0
--     go acc ma | isNaN ev  = acc
--               | otherwise = go (ev : acc) ma'
--       where
--         ec  = eigenvector ma
--         ev  = eigenvalue ma ec
--         ec' = (<$ zero) <$> ec
--         ma' = ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec)

{-

>>> mt = V2 (V2 1 2) (V2 3 4)
>>> ev = eigenvector mt
>>> el = eigenvalue mt ev

>>> ev
V2 0.41597355791928425 0.9093767091321241

>>> el
5.372281323269014

>>> el *!! identity :: M22 Double
V2 (V2 5.372281323269014 0.0) (V2 0.0 5.372281323269014)

>>> (mt - el *!! identity)
V2 (V2 (-4.372281323269014) 2.0) (V2 3.0 (-1.3722813232690143))

>>> luFinite (mt - el *!! identity)
(V2 (V2 (-4.372281323269014) 0.0) (V2 3.0 0.0),V2 (V2 1.0 (-0.4574271077563381)) (V2 0.0 NaN))

>>> luDetFinite (mt - el *!! identity)
NaN

>>> eigenvalues mt
[-0.37228132326901475,5.372281323269014]

>>> m3 = V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9)

>>> eigenvalues m3
[-1.1168439698070434,16.116843969807043]

>>> m4 = V4 (V4 1 2 3 4) (V4 5 6 7 8) (V4 9 10 11 12) (V4 13 14 15 16)

>>> eigenvalues m4
[-2.2093727122985376,36.20937271229855]

>>> m5 = fromJust $ fromVector @5 (fromJust . fromVector @5 <$> (fromList <$> fromList [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,18,19,20],[21,22,23,24,25]]))

>>> m5
V {toVector = [V {toVector = [1,2,3,4,5]},V {toVector = [6,7,8,9,10]},V {toVector = [11,12,13,14,15]},V {toVector = [16,17,18,19,20]},V {toVector = [21,22,23,24,25]}]}

>>> eigenvalues m5
[-3.64208073700242,68.6420807370024]

>>> lx = V3 (V2 1 2) (V2 3 4) (V2 5 6)

>>> eigenvalues (lx !*! adjoint lx)
[0.264505087265819,90.73549491273418]

-}

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [x, y] <- readChar8'
        case (x > y, x == y) of
            (True, _   ) -> print (x + y)
            (_   , True) -> print x
            _            -> print $ y - (y `mod` x) `div` 2

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[x, y] <- getInts 2
    pure $ putInts $ pure $ case  divMod y x  of
      (0, _) -> x + y
      (_, r) -> y - div r 2

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

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM_ )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( unfoldr )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue m x = (let V1 (V1 p) = (helper x !*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q) where helper = adjoint . fmap V1

-- eigenvalues m = go [] m
--   where
--     c0 = eigenvector m
--     e0 = eigenvalue m c0
--     go acc ma | isNaN ev  = acc
--               | otherwise = go (ev : acc) ma'
--       where
--         ec  = eigenvector ma
--         ev  = eigenvalue ma ec
--         ec' = (<$ zero) <$> ec
--         ma' = ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec)

{-

>>> mt = V2 (V2 1 2) (V2 3 4)
>>> ev = eigenvector mt
>>> el = eigenvalue mt ev

>>> ev
V2 0.41597355791928425 0.9093767091321241

>>> el
5.372281323269014

>>> el *!! identity :: M22 Double
V2 (V2 5.372281323269014 0.0) (V2 0.0 5.372281323269014)

>>> (mt - el *!! identity)
V2 (V2 (-4.372281323269014) 2.0) (V2 3.0 (-1.3722813232690143))

>>> luFinite (mt - el *!! identity)
(V2 (V2 (-4.372281323269014) 0.0) (V2 3.0 0.0),V2 (V2 1.0 (-0.4574271077563381)) (V2 0.0 NaN))

>>> luDetFinite (mt - el *!! identity)
NaN

>>> eigenvalues mt
[-0.37228132326901475,5.372281323269014]

>>> m3 = V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9)

>>> eigenvalues m3
[-1.1168439698070434,16.116843969807043]

>>> m4 = V4 (V4 1 2 3 4) (V4 5 6 7 8) (V4 9 10 11 12) (V4 13 14 15 16)

>>> eigenvalues m4
[-2.2093727122985376,36.20937271229855]

>>> m5 = fromJust $ fromVector @5 (fromJust . fromVector @5 <$> (fromList <$> fromList [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,18,19,20],[21,22,23,24,25]]))

>>> m5
V {toVector = [V {toVector = [1,2,3,4,5]},V {toVector = [6,7,8,9,10]},V {toVector = [11,12,13,14,15]},V {toVector = [16,17,18,19,20]},V {toVector = [21,22,23,24,25]}]}

>>> eigenvalues m5
[-3.64208073700242,68.6420807370024]

>>> lx = V3 (V2 1 2) (V2 3 4) (V2 5 6)

>>> eigenvalues (lx !*! adjoint lx)
[0.264505087265819,90.73549491273418]

-}

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [x, y] <- readChar8'
        case (x > y, x == y) of
            (True, _   ) -> print (x + y)
            (_   , True) -> print x
            _            -> if even (x + y) then print $ (x + y) `div` 2 else print $ (x + y + if odd x then x else y) `div` 2

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM_ )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( unfoldr )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue m x = (let V1 (V1 p) = (helper x !*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q) where helper = adjoint . fmap V1

-- eigenvalues m = go [] m
--   where
--     c0 = eigenvector m
--     e0 = eigenvalue m c0
--     go acc ma | isNaN ev  = acc
--               | otherwise = go (ev : acc) ma'
--       where
--         ec  = eigenvector ma
--         ev  = eigenvalue ma ec
--         ec' = (<$ zero) <$> ec
--         ma' = ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec)

{-

>>> mt = V2 (V2 1 2) (V2 3 4)
>>> ev = eigenvector mt
>>> el = eigenvalue mt ev

>>> ev
V2 0.41597355791928425 0.9093767091321241

>>> el
5.372281323269014

>>> el *!! identity :: M22 Double
V2 (V2 5.372281323269014 0.0) (V2 0.0 5.372281323269014)

>>> (mt - el *!! identity)
V2 (V2 (-4.372281323269014) 2.0) (V2 3.0 (-1.3722813232690143))

>>> luFinite (mt - el *!! identity)
(V2 (V2 (-4.372281323269014) 0.0) (V2 3.0 0.0),V2 (V2 1.0 (-0.4574271077563381)) (V2 0.0 NaN))

>>> luDetFinite (mt - el *!! identity)
NaN

>>> eigenvalues mt
[-0.37228132326901475,5.372281323269014]

>>> m3 = V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9)

>>> eigenvalues m3
[-1.1168439698070434,16.116843969807043]

>>> m4 = V4 (V4 1 2 3 4) (V4 5 6 7 8) (V4 9 10 11 12) (V4 13 14 15 16)

>>> eigenvalues m4
[-2.2093727122985376,36.20937271229855]

>>> m5 = fromJust $ fromVector @5 (fromJust . fromVector @5 <$> (fromList <$> fromList [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,18,19,20],[21,22,23,24,25]]))

>>> m5
V {toVector = [V {toVector = [1,2,3,4,5]},V {toVector = [6,7,8,9,10]},V {toVector = [11,12,13,14,15]},V {toVector = [16,17,18,19,20]},V {toVector = [21,22,23,24,25]}]}

>>> eigenvalues m5
[-3.64208073700242,68.6420807370024]

>>> lx = V3 (V2 1 2) (V2 3 4) (V2 5 6)

>>> eigenvalues (lx !*! adjoint lx)
[0.264505087265819,90.73549491273418]

-}

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [x, y] <- readChar8'
        case (x < y, x == y) of
            (True, _   ) -> print (x + y)
            (_   , True) -> print x
            _            -> if even (x + y) then print $ (x + y) `div` 2 else print $ (x + y + if odd x then x else y) `div` 2

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[x, y] <- getInts 2
    pure $ putInts $ pure $ if  x > y
      then  x + y
      else  quot (x + y) 2

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


The Happy Farm 5 creators decided to invent the mechanism of cow grazing. The cows in the game are very slow and they move very slowly, it can even be considered that they stand still. However, carnivores should always be chased off them. For that a young player Vasya decided to make the shepherd run round the cows along one and the same closed path. It is very important that the cows stayed strictly inside the area limited by the path, as otherwise some cows will sooner or later be eaten. To be absolutely sure in the cows' safety, Vasya wants the path completion time to be minimum.The new game is launched for different devices, including mobile phones. That's why the developers decided to quit using the arithmetics with the floating decimal point and use only the arithmetics of integers. The cows and the shepherd in the game are represented as points on the plane with integer coordinates. The playing time is modeled by the turns. During every turn the shepherd can either stay where he stands or step in one of eight directions: horizontally, vertically, or diagonally. As the coordinates should always remain integer, then the length of a horizontal and vertical step is equal to 1, and the length of a diagonal step is equal to . The cows do not move. You have to minimize the number of moves the shepherd needs to run round the whole herd.

The first line contains an integer N which represents the number of cows in the herd (1 ≤ N ≤ 105). Each of the next N lines contains two integers Xi and Yi which represent the coordinates of one cow of (|Xi|, |Yi| ≤ 106). Several cows can stand on one point.

Print the single number — the minimum number of moves in the sought path.

NotePicture for the example test: The coordinate grid is painted grey, the coordinates axes are painted black, the cows are painted red and the sought route is painted green.

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

gao a = 4 + sum [maximum (map f a) | f <- [sum, foldl1 (-), foldl1 subtract, negate . sum]]
main = do C.interact $ C.pack . show . gao . map (map (fst . fromJust . C.readInt) . C.words) . tail . C.lines

{-
	2 * (max{x} - min{x})
	2 * (max{y} - min{y})
	-|max{x} + max{y} - max{x + y}|
	-|min{x + y} - min{x} - min{y}|
	-|max{x} - min{y} - max{x - y}|
	-|max{y} - min{x} - max{y - x}|
=	max{x+y}+max{x-y}+max{y-x}+max{-x-y}
-}-}
{-
# 	When 	Who 	Problem 	Lang 	Verdict 	Time 	Memory
229404 	Dec 24, 2010 11:07:18 AM 	watashi 	C - Happy Farm 5 	Haskell 	Time limit exceeded on test 69 	2000 ms 	14888 KB
-}


Given the string $$$s$$$ of decimal digits (0-9) of length $$$n$$$.A substring is a sequence of consecutive characters of a string. The substring of this string is defined by a pair of indexes — with its left and right ends. So, each pair of indexes ($$$l, r$$$), where $$$1 \le l \le r \le n$$$, corresponds to a substring of the string $$$s$$$. We will define as $$$v(l,r)$$$ the numeric value of the corresponding substring (leading zeros are allowed in it).For example, if $$$n=7$$$, $$$s=$$$"1003004", then $$$v(1,3)=100$$$, $$$v(2,3)=0$$$ and $$$v(2,7)=3004$$$.You are given $$$n$$$, $$$s$$$ and an integer $$$w$$$ ($$$1 \le w < n$$$).You need to process $$$m$$$ queries, each of which is characterized by $$$3$$$ numbers $$$l_i, r_i, k_i$$$ ($$$1 \le l_i \le r_i \le n; 0 \le k_i \le 8$$$).The answer to the $$$i$$$th query is such a pair of substrings of length $$$w$$$ that if we denote them as $$$(L_1, L_1+w-1)$$$ and $$$(L_2, L_2+w-1)$$$, then:  $$$L_1 \ne L_2$$$, that is, the substrings are different;  the remainder of dividing a number $$$v(L_1, L_1+w-1) \cdot v(l_i, r_i) + v(L_2, L_2 + w - 1)$$$ by $$$9$$$ is equal to $$$k_i$$$. If there are many matching substring pairs, then find a pair where $$$L_1$$$ is as small as possible. If there are many matching pairs in this case, then minimize $$$L_2$$$.Note that the answer may not exist.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — number of input test cases. The first line of each test case contains a string $$$s$$$, which contains only the characters 0-9 and has a length $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$). The second line contains two integers $$$w, m$$$ ($$$1 \le w < n, 1 \le m \le 2 \cdot 10^5$$$), where $$$n$$$ — is the length of the given string $$$s$$$. The number $$$w$$$ denotes the lengths of the substrings being searched for, and $$$m$$$ is the number of queries to be processed. The following $$$m$$$ lines contain integers $$$l_i, r_i, k_i$$$ ($$$1 \le l_i \le r_i \le n$$$, $$$0 \le k_i \le 8$$$) — $$$i$$$th query parameters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$. It is also guaranteed that the sum of $$$m$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each request, print in a separate line:    left borders of the required substrings: $$$L_1$$$ and $$$L_2$$$; -1 -1 otherwise, if there is no solution.  If there are several solutions, minimize $$$L_1$$$ first, and minimize $$$L_2$$$ second.

NoteConsider the first test case of example inputs. In this test case $$$n=7$$$, $$$s=$$$"1003004", $$$w=4$$$ and one query $$$l_1=1$$$, $$$r_1=2$$$, $$$k_1=1$$$. Note that $$$v(1,2)=10$$$. We need to find a pair of substrings of length $$$4$$$ such that $$$v(L_1, L_1+3)\cdot10+v(L_2,L_2+3)$$$ has a remainder of $$$k_1=1$$$ when divided by $$$9$$$. The values $$$L_1=2, L_2=4$$$ actually satisfy all the requirements: $$$v(L_1, L_1+w-1)=v(2,5)=30$$$, $$$v(L_2, L_2+w-1)=v(4,7)=3004$$$. Indeed, $$$30\cdot10+3004=3304$$$, which has a remainder of $$$1$$$ when divided by $$$9$$$. It can be shown that $$$L_1=2$$$ is the minimum possible value, and $$$L_2=4$$$ is the minimum possible with $$$L_1=2$$$.

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

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

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

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

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

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

import Data.Char

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

type SolutionState = (A.Array (Int, Int) (Maybe (Int, Int)), UA.UArray Int Int)

preSolve :: B8.ByteString -> Int -> SolutionState
preSolve s w = (answersMapArr, digitsSumArr)
    where
        n = B8.length s

        digits :: [Int]
        digits = (0:) . L.map (\c -> ord c - ord '0') $ B8.unpack s

        digitsArr :: UA.UArray Int Int
        digitsArr = tracing "digitsArr" . UA.listArray (0, n) $ digits

        digitsSumArr :: UA.UArray Int Int
        digitsSumArr = tracing "digitsSumArr" . UA.listArray (0, n) . L.scanl1 (+) $ digits

        prefixesByMod :: IM.IntMap [Int]
        prefixesByMod = tracing "prefixesByMod" . flip MS.execState (IM.empty :: IM.IntMap [Int]) $ do
            M.forM_ (reverse [w .. n]) $ \i -> do
                let l = i - w
                    r = i
                let sumMod = (digitsSumArr UA.! r - digitsSumArr UA.! l) `mod` 9
                MS.modify $ IM.insertWith (\existingValue newValue -> L.take 2 $ existingValue ++ newValue) sumMod [l + 1]

        answersMapArr :: A.Array (Int, Int) (Maybe (Int, Int))
        answersMapArr = STA.runSTArray $ do
            answers <- STA.newArray ((0, 0), (8, 8)) Nothing
            M.forM_ [0 .. 8] $ \k -> do
                M.forM_ [0 .. 8] $ \v -> do
                    M.forM_ [0 .. 8] $ \x -> do
                        M.forM_ [0 .. 8] $ \y -> do
                            M.runMaybeT $ do
                                M.guard $ (x * v + y) `mod` 9 == k

                                ls1 <- M.MaybeT . return $ x `IM.lookup` prefixesByMod
                                ls2 <- M.MaybeT . return $ y `IM.lookup` prefixesByMod

                                M.guard $ x /= y || length (L.take 2 ls1) == 2

                                answer@(l1, l2) <- M.MaybeT . return $ if x == y then
                                            (,) <$> listToMaybe ls1 <*> listToMaybe (tail ls1)
                                        else
                                            (,) <$> listToMaybe ls1 <*> listToMaybe ls2

                                MT.lift $ do
                                    tracingM "- k" k
                                    tracingM "- v" v
                                    tracingM "- x" x
                                    tracingM "- y" y
                                    tracingM "answer " answer

                                MT.lift . modifyArray answers (k, v) $ \case
                                    Nothing -> Just answer
                                    Just oldValue -> Just $ min oldValue answer

            return $ answers

solve :: SolutionState -> Int -> Int -> Int -> (Int, Int)
solve (answersMapArr, digitsSumArr) l r k = (l1, l2)
    where
        (l1, l2) = fromMaybe (-1, -1) $ answersMapArr A.! (k, v)
        v = (digitsSumArr UA.! r - digitsSumArr UA.! (l - 1)) `mod` 9

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        s <- B8.getLine <&> B8.filter isAlphaNum
        [w, m] <- B8.getLine <&> readIntB8s
        let state = preSolve s w
        M.replicateM_ m $ do
            [l, r, k] <- B8.getLine <&> readIntB8s
            let (l1, l2) = solve state l r k
            printf "%d %d\n" l1 l2
            traceM $ "----------------------"


Bob has a rectangular chocolate bar of the size W × H. He introduced a cartesian coordinate system so that the point (0, 0) corresponds to the lower-left corner of the bar, and the point (W, H) corresponds to the upper-right corner. Bob decided to split the bar into pieces by breaking it. Each break is a segment parallel to one of the coordinate axes, which connects the edges of the bar. More formally, each break goes along the line x = xc or y = yc, where xc and yc are integers. It should divide one part of the bar into two non-empty parts. After Bob breaks some part into two parts, he breaks the resulting parts separately and independently from each other. Also he doesn't move the parts of the bar. Bob made n breaks and wrote them down in his notebook in arbitrary order. At the end he got n + 1 parts. Now he wants to calculate their areas. Bob is lazy, so he asks you to do this task.

The first line contains 3 integers W, H and n (1 ≤ W, H, n ≤ 100) — width of the bar, height of the bar and amount of breaks. Each of the following n lines contains four integers xi, 1, yi, 1, xi, 2, yi, 2 — coordinates of the endpoints of the i-th break (0 ≤ xi, 1 ≤ xi, 2 ≤ W, 0 ≤ yi, 1 ≤ yi, 2 ≤ H, or xi, 1 = xi, 2, or yi, 1 = yi, 2). Breaks are given in arbitrary order. It is guaranteed that the set of breaks is correct, i.e. there is some order of the given breaks that each next break divides exactly one part of the bar into two non-empty parts.

Output n + 1 numbers — areas of the resulting parts in the increasing order.

import Control.Monad
import Data.List

getA = fmap (map read . words) getLine

main = do
	[w,h,n] <- getA
	a <- replicateM n getA
	putStr $ unwords $ map show $ sort $ gao [0,0,w,h] a

gao [x1,y1,x2,y2] [] = [(x2 - x1) * (y2 - y1)]
gao [x1,y1,x2,y2] a = gao r p ++ gao s q where
	c@[x3,y3,x4,y4] = head $ filter (\[i,j,k,l] -> (i==x1 && k==x2) || (j==y1 && l==y2)) a
	(r@[x5,y5,x6,y6],s) = if x3==x4 then ([x1,y1,x3,y2],[x3,y1,x2,y2]) else ([x1,y1,x2,y3],[x1,y3,x2,y2])
	(p,q) = partition (\[i,j,k,l] -> x5<=i && y5<=j && k<=x6 && l<=y6) $ delete c a

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
import Text.Printf

type Pos = (Int, Int, Int, Int)

conv :: [Int] -> Pos
conv [x1, y1, x2, y2] = (x1, y1, x2, y2)
conv _            = error "conv: Invalid format"

divide :: Pos -> Pos -> [Pos]
divide this@(x1, y1, x2, y2) byThat@(x1', y1', x2', y2')
  | x1' == x2' && x1 < x1' && x1' < x2 && y1 == y1' && y2 == y2'= do
      [(x1, y1, x1', y2), (x1', y1, x2, y2)]
  | y1' == y2' && y1 < y1' && y1' < y2 && x1 == x1' && x2 == x2'= do
      [(x1, y1, x2, y1'), (x1, y1', x2, y2)]
  | otherwise  = []

calcArea :: Pos -> Int
calcArea (x1, y1, x2, y2) = (x2 - x1) * (y2 - y1)

findBreak cs bs = head $ do
  c <- cs
  b <- bs
  case divide c b of
    _ :_ -> [(c, b)]
    _    -> []

main :: IO ()
main = do
  let readInts = map read . words :: String -> [Int]
  w : h : n : _ <- readInts <$> getLine
  breaks <- replicateM n $ conv . readInts <$> getLine
  let chocolate = (0, 0, w, h)
      findBreak cs bs = head $ do
        c <- cs
        b <- bs
        case divide c b of
          _ :_ -> [(c, b)]
          _    -> []
      bob'sJob cs [] = cs
      bob'sJob cs bs = do
        let (c, b) = findBreak cs bs
        bob'sJob (delete c cs ++ (divide c b)) (delete b bs)
      answer = sort . map calcArea $ bob'sJob [chocolate] breaks
  putStrLn . intercalate " " $ map show answer

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Ord
import Text.Printf

type Pos = (Int, Int, Int, Int)

conv :: [Int] -> Pos
conv [x1, y1, x2, y2] = (x1, y1, x2, y2)
conv _            = error "conv: Invalid format"

divide :: Pos -> Pos -> Maybe [Pos]
divide this@(x1, y1, x2, y2) byThat@(x1', y1', x2', y2')
  | x1' == x2' && x1 < x1' && x1' < x2 && y1 == y1' && y2 == y2'= do
      Just $ [(x1, y1, x1', y2), (x1', y1, x2, y2)]
  | y1' == y2' && y1 < y1' && y1' < y2 && x1 == x1' && x2 == x2'= do
      Just $ [(x1, y1, x2, y1'), (x1, y1', x2, y2)]
  | otherwise  = Nothing

calcArea :: Pos -> Int
calcArea (x1, y1, x2, y2) = (x2 - x1) * (y2 - y1)

main :: IO ()
main = do
  let readInts = map read . words :: String -> [Int]
  w : h : n : _ <- readInts <$> getLine
  breaks <- replicateM n $ conv . readInts <$> getLine
  let chocolate = (0, 0, w, h)
      bob'sJob parts b = do
        let check p1 p2 = maybe [p1] id $ divide p1 p2
        concat $ map (`check` b) parts
      answer = sort . map calcArea $ foldl bob'sJob [chocolate] breaks
  putStrLn . intercalate " " $ map show answer


Connect the countless points with lines, till we reach the faraway yonder.There are n points on a coordinate plane, the i-th of which being (i, yi).Determine whether it's possible to draw two parallel and non-overlapping lines, such that every point in the set lies on exactly one of them, and each of them passes through at least one point in the set.

The first line of input contains a positive integer n (3 ≤ n ≤ 1 000) — the number of points. The second line contains n space-separated integers y1, y2, ..., yn ( - 109 ≤ yi ≤ 109) — the vertical coordinates of each point.

Output "Yes" (without quotes) if it's possible to fulfill the requirements, and "No" otherwise. You can print each letter in any case (upper or lower).

NoteIn the first example, there are five points: (1, 7), (2, 5), (3, 8), (4, 6) and (5, 9). It's possible to draw a line that passes through points 1, 3, 5, and another one that passes through points 2, 4 and is parallel to the first one.In the second example, while it's possible to draw two lines that cover all points, they cannot be made parallel.In the third example, it's impossible to satisfy both requirements at the same time.

main = interact foo

type Point = (Int, Int)
type Line = [Point]

foo :: String -> String
foo inp =
    let points = zip [1..] . map read . words . (!! 1) . lines $ inp :: [Point]
    in if mlines points [] []
        then "Yes"
        else "No"

baz :: Point -> Point -> Double
baz p1 p2 =
    let (x1, y1) = p1
        (x2, y2) = p2
    in (fromIntegral $ y1 - y2) / (fromIntegral $ x1 - x2)

k :: Double -> Point -> Double
k b (x, y) = (fromIntegral y) - b * (fromIntegral x)

check :: Line -> Line -> Bool
check [] _ = False
check _ [] = False
check l [p] = not $ compatible l p
check [p] l = check l [p]
check ps1 ps2 =
    let p11 = head ps1
        p21 = ps1 !! 1
        p12 = ps2 !! 0
        p22 = ps2 !! 1
        b1 = baz p11 p21
        b2 = baz p12 p22
    in if b1 == b2
        then if k b1 p11 == k b2 p12
            then False
            else True
        else False

compatible :: Line -> Point -> Bool
compatible [] _ = True
compatible [_] _ = True
compatible l p =
    let p1 = head l
    in baz p1 p == baz (l !! 0) (l !! 1)

mlines :: [Point] -> Line -> Line -> Bool
mlines [] l1 l2 = check l1 l2
mlines _ l1 l2 | not $ validate l1 l2 = False
mlines (p:ps) l1 l2 =
    let c1 = compatible l1 p
        c2 = compatible l2 p
        per :: Point -> Bool
        per pp =
            if mlines ps (pp:l1) l2
                then True
                else mlines ps l1 (pp:l2)
    in
        if c1 && c2
            then if length l1 < 2 || length l2 < 2
                then per p
                else False
            else if c1
                then mlines ps (p:l1) l2
                else if c2
                    then mlines ps l1 (p:l2)
                    else False

validate :: Line -> Line -> Bool
validate [] _ = True
validate _ [] = True
validate [_] [_] = True
validate l1 l2 = check l1 l2

main = interact foo

type Point = (Int, Int)
type Line = [Point]

foo :: String -> String
foo inp =
    let points = zip [1..] . map read . words . (!! 1) . lines $ inp :: [Point]
    in if mlines points [] []
        then "Yes"
        else "No"

baz :: Point -> Point -> Double
baz p1 p2 =
    let (x1, y1) = p1
        (x2, y2) = p2
    in (fromIntegral $ y1 - y2) / (fromIntegral $ x1 - x2)

k :: Double -> Point -> Double
k b (x, y) = (fromIntegral y) - b * (fromIntegral x)

check :: Line -> Line -> Bool
check [] _ = False
check _ [] = False
check l [p] = not $ compatible l p
check [p] l = check l [p]
check ps1 ps2 =
    let p11 = head ps1
        p21 = ps1 !! 1
        p12 = ps2 !! 0
        p22 = ps2 !! 1
        b1 = baz p11 p21
        b2 = baz p12 p22
    in if b1 == b2
        then if k b1 p11 == k b2 p12
            then False
            else True
        else False

compatible :: Line -> Point -> Bool
compatible [] _ = True
compatible [_] _ = True
compatible l p =
    let p1 = head l
    in baz p1 p == baz (l !! 0) (l !! 1)

mlines :: [Point] -> Line -> Line -> Bool
mlines [] l1 l2 = check l1 l2
mlines (p:ps) l1 l2 =
    let c1 = compatible l1 p
        c2 = compatible l2 p
        per :: Point -> Bool
        per pp =
            if mlines ps (pp:l1) l2
                then True
                else mlines ps l1 (pp:l2)
    in if validate l1 l2
        then
            if c1 && c2
                then if length l1 < 2 || length l2 < 2
                    then per p
                    else False
                else if c1
                    then mlines ps (p:l1) l2
                    else if c2
                        then mlines ps l1 (p:l2)
                        else False
        else False

validate :: Line -> Line -> Bool
validate [] _ = True
validate _ [] = True
validate [_] [_] = True
validate l1 l2 = check l1 l2

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

import Data.Int (Int64)

data Pnt = Pnt (Int64, Int64) deriving Eq

parallel (Pnt (x1, y1)) (Pnt (x2, y2)) (Pnt (x3, y3)) (Pnt (x4, y4))
    | (y2 - y1) * (x4 - x3) == (y4 - y3) * (x2 - x1) = True | otherwise = False

divide p1 p2 [] b = b
divide p1 p2 (px:xs) b | parallel p1 p2 p1 px = divide p1 p2 xs b
                       | otherwise = divide p1 p2 xs (px:b)

test xs p1 p2 | length d == 0 = False | length d == 1 = True
              | otherwise = let (dx:dy:ds) = d in parallel p1 p2 dx dy && divide dx dy ds [] == []
    where d = divide p1 p2 xs []

run (x:y:z:xs) | divide y z (x:xs) [] == [x] = True | otherwise = any (test (y:z:xs) x) (y:z:xs)

main :: IO ()
main = do
    _ <- getLine
    (map Pnt . zip [1..] . map (read :: String -> Int64) . words -> xs) <- getLine
    putStrLn $ case run xs of
        True  -> "Yes"
        False -> "No"

main = interact foo

type Point = (Int, Int)
type Line = [Point]

foo :: String -> String
foo inp =
    let points = zip [1..] . map read . words . (!! 1) . lines $ inp :: [Point]
    in if mlines points [] []
        then "Yes"
        else "No"

baz :: Point -> Point -> Double
baz p1 p2 =
    let (x1, y1) = p1
        (x2, y2) = p2
    in (fromIntegral $ y1 - y2) / (fromIntegral $ x1 - x2)

k :: Double -> Point -> Double
-- k a b | trace ("k " ++ show a ++ " " ++ show b) False = undefined
k b (x, y) = (fromIntegral y) - b * (fromIntegral x)

check :: Line -> Line -> Bool
-- check l1 l2 | trace ("check " ++ show l1 ++ " " ++ show l2) False = undefined
check [] _ = False
check _ [] = False
check [p] l = check l [p]
check l [p] = not $ compatible l p
check ps1 ps2 =
    let p11 = head ps1
        p21 = ps1 !! 1
        p12 = ps2 !! 0
        p22 = ps2 !! 1
        b1 = baz p11 p21
        b2 = baz p12 p22
    in if b1 == b2
        then if k b1 p11 == k b2 p12
            then False
            else True
        else False

compatible :: Line -> Point -> Bool
-- compatible l p | trace ("compatible " ++ show l ++ " " ++ show p) False = undefined
compatible [] _ = True
compatible [_] _ = True
compatible l p =
    let p1 = head l
    in baz p1 p == baz (l !! 0) (l !! 1)

mlines :: [Point] -> Line -> Line -> Bool
-- mlines a b c | trace ("mlines " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
mlines [] l1 l2 = check l1 l2
-- mlines ps [] [] = mlines (drop 4 ps) (take 2 ps) (take 2 . drop 2 $ ps)
mlines (p:ps) l1 l2 =
    let c1 = compatible l1 p
        c2 = compatible l2 p
        per :: Point -> Bool
        per pp =
            if mlines ps (pp:l1) l2
                then True
                else mlines ps l1 (pp:l2)
    in if check l1 l2
        then if c1 && c2
            then if length l1 < 2 || length l2 < 2
                then per p
                else False
            else if c1
                then mlines ps (p:l1) l2
                else if c2
                    then mlines ps l1 (p:l2)
                    else False
        else False


You have been given n distinct integers a1, a2, ..., an. You can remove at most k of them. Find the minimum modular m (m > 0), so that for every pair of the remaining integers (ai, aj), the following unequality holds: .

The first line contains two integers n and k (1  ≤ n  ≤ 5000, 0 ≤ k ≤ 4), which we have mentioned above.  The second line contains n distinct integers a1, a2, ..., an (0 ≤ ai ≤ 106).

Print a single positive integer — the minimum m.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts #-}
import Data.List (tails)
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array (accumArray,(!))

main = do
  (n:k:as) <- map read . words <$> getContents
  let diffs = accumArray (+) 0 (0,10^6)
              [ (abs (a-b),1) | (a:t) <- tails as , b <- t ]
  print $ head $ filter (check diffs k as) [1..]

check diffs k _ m
  | sum [ diffs!d | d <- [m,2*m..10^6] ] > k*(k+1) `div` 2 = False
check diffs k as m = runST $ do
  closed <- newArray (0,m-1) False :: ST s (STUArray s Int Bool)
  let go (-1) _ = return False
      go k (a:as) = do
        let i = a `mod` m
        c <- readArray closed i
        if c then go (k-1) as else do
          writeArray closed i True
          go k as
      go _ [] = return True
  go k as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array
import Control.Monad

main = do
  (n:k:as) <- map (fst . fromJust . B.readInt) . B.words <$> B.getContents
  let diffs = accumArray (+) 0 (0,10^6)
              [ (abs (a-b),1) | (a:t) <- tails as , b <- t ]
  print $ head $ filter (check diffs k as) [1..]

check diffs k _ m
  | sum [ diffs!d | d <- [m,2*m..10^6] ] > k*(k+1) `div` 2 = False
check diffs k as m = runST $ do
  closed <- newArray (0,m-1) False :: ST s (STUArray s Int Bool)
  let go (-1) _ = return False
      go k (a:as) = do
        let i = a `mod` m
        c <- readArray closed i
        if c then go (k-1) as else do
          writeArray closed i True
          go k as
      go _ [] = return True
  go k as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet as IS
import Data.List

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> Int -> [Int] -> Int
solve n k xs = head $ filter check $ filter check0 [1..]
   where
     !arr = listArray (0,n-1) xs :: UArray Int Int
     !diffmax = maximum xs - minimum xs
     !lim = k*(k+1)`div`2
     !diffs = runSTUArray $ do
       d <- newArray (0,1000000) 0 :: ST s (STUArray s Int Int)
       forM_ [0..n-1] $ \i-> do
         forM_ [i+1..n-1] $ \j-> do
           unsafeModify d (unsafeAt arr j - unsafeAt arr i) (1+)
       return d
     check0 m = (<=lim) . sum $ map (unsafeAt diffs) [m,m+m..diffmax]
     check m = go 0 IS.empty $ map (`rem`m) xs
      where
        go !cnt !used (x:xs)
          | cnt > k = False
          | IS.member x used = go (cnt+1) (IS.insert x used) xs
          | otherwise = go cnt (IS.insert x used) xs
        go cnt _ _ = cnt <= k

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet as IS
import Data.List

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> Int -> [Int] -> Int
solve n k xs = head $ filter check $ filter check0 [1..]
   where
     !arr = listArray (0,n-1) xs :: UArray Int Int
     !diffmax = maximum xs - minimum xs
     !lim = k*(k+1)`div`2
     !diffs = runSTUArray $ do
       d <- newArray (0,1000000) 0 :: ST s (STUArray s Int Int)
       forM_ [0..n-1] $ \i-> do
         forM_ [i+1..n-1] $ \j-> do
           unsafeModify d (unsafeAt arr j - unsafeAt arr i) (1+)
       return d
     check0 m = (<=lim) . sum $ map (unsafeAt diffs) [m,m+m..diffmax]
     check m = runST $ do
       used <- newArray (0,m) False :: ST s (STUArray s Int Bool)
       let go !cnt (x:xs)
             | cnt > k = return False
             | otherwise = do
                 let !r = x `rem` m
                 flg <- unsafeRead used r
                 if flg
                    then go (cnt+1) xs
                    else do
                      unsafeWrite used r True
                      go cnt xs
           go cnt _ = return $! cnt <= k
       go 0 xs
{-
     check m = go 0 IS.empty $ map (`rem`m) xs
      where
        go !cnt !used (x:xs)
          | cnt > k = False
          | IS.member x used = go (cnt+1) (IS.insert x used) xs
          | otherwise = go cnt (IS.insert x used) xs
        go cnt _ _ = cnt <= k
-}

{-# LANGUAGE FlexibleContexts #-}
import Data.List (tails)
import Data.Array.ST.Safe (STUArray,newArray,readArray,writeArray)
import Control.Monad (forM_)
import Control.Monad.ST.Safe (ST,runST)
main = interact $ show . solve . map read . words
solve (n:k:ns) = runST $ do
  a <- newArray (0,1000000) 0 :: ST s (STUArray s Int Int)
  forM_ (tails ns) $ \ns -> if null ns then return () else do
    forM_ (tail ns) $ \n -> let d = abs (head ns - n)
                            in readArray a d >>= writeArray a d . succ
  let threshold = k * (k+1) `div` 2
      validate m = go m 0 where
        go _ c | c > threshold = validate (m+1)
        go i _ | i > 1000000 = return m
        go i c = do
          c' <- readArray a i
          go (i+m) (c+c')
  validate (n-k)

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array
import Control.Monad

-- import Debug.Trace

main = do
  (n:k:as) <- map (fst . fromJust . B.readInt) . B.words <$> B.getContents
  let diffs = accumArray (flip (:)) [] (0,10^6)
              [ (abs (a-b),(a,b)) | (a:t) <- tails as, b <- t ]
  print $ head $ filter (check'' diffs k) [1..]

check k as m = (<= k) $ sum $ map (pred . length) $ group $ sort $ map (`mod` m) as

check' k as m = runST $ do
  t <- newArray (0,m-1) False :: ST s (STUArray s Int Bool)
  let go (-1) _ = return False
      go k (a:as) = do
        let i = a `mod` m
        p <- readArray t i
        writeArray t i True
        go (if p then k-1 else k) as
      go _ [] = return True
  go k as

check'' diffs k m = runST $ do
  parent <- newListArray (0,10^6) [0..] :: ST s (STUArray s Int Int)
  size <- newListArray (0,10^6) (repeat 1) :: ST s (STUArray s Int Int)
  let -- go k ps | traceShow (k,ps) False = undefined
      go (-1) _ = return False
      go k ((a,b):ps) = do
        same <- liftM2 (==) (rep a) (rep b)
        if same then go k ps else do
          merge a b
          go (k-1) ps
      go _ [] = return True
      rep i = do
        p <- readArray parent i
        if p == i then return i else do
          r <- rep p
          writeArray parent i r
          return r
      merge i j = do
        -- traceM $ "Merge " ++ show (i,j)
        ri <- rep i
        rj <- rep j
        si <- readArray size ri
        sj <- readArray size rj
        if si <= sj
          then do
            writeArray parent ri rj
            writeArray size rj (si+sj)
          else do
            writeArray parent rj ri
            writeArray size ri (si+sj)
  go k $ concatMap (diffs!) [m,2*m..4999]

{- Old version

{-# LANGUAGE FlexibleContexts #-}
import Data.List (tails)
import Data.Array.ST (STUArray,newArray,readArray,writeArray)
import Control.Monad (forM_)
import Control.Monad.ST (ST,runST)
main = interact $ show . solve . map read . words
solve (n:k:ns) = runST $ do
  a <- newArray (0,1000000) 0 :: ST s (STUArray s Int Int)
  forM_ (tails ns) $ \ns -> if null ns then return () else do
    forM_ (tail ns) $ \n -> let d = abs (head ns - n)
                            in readArray a d >>= writeArray a d . succ
  let threshold = k * (k+1) `div` 2
      validate m = go m 0 where
        go _ c | c > threshold = validate (m+1)
        go i _ | i > 1000000 = return m
        go i c = do
          c' <- readArray a i
          go (i+m) (c+c')
  validate (n-k)

-}

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe

main = do
  (n:k:as) <- map (fst . fromJust . B.readInt) . B.words <$> B.getContents
  print $ head $ filter (check' k as) [1..]

check k as m = (<= k) $ sum $ map (pred . length) $ group $ sort $ map (`mod` m) as

check' k as m = runST $ do
  t <- newArray (0,m-1) False :: ST s (STUArray s Int Bool)
  let go (-1) _ = return False
      go k (a:as) = do
        let i = a `mod` m
        p <- readArray t i
        writeArray t i True
        go (if p then k+1 else k) as
      go _ [] = return True
  go k as

{- Old version

{-# LANGUAGE FlexibleContexts #-}
import Data.List (tails)
import Data.Array.ST (STUArray,newArray,readArray,writeArray)
import Control.Monad (forM_)
import Control.Monad.ST (ST,runST)
main = interact $ show . solve . map read . words
solve (n:k:ns) = runST $ do
  a <- newArray (0,1000000) 0 :: ST s (STUArray s Int Int)
  forM_ (tails ns) $ \ns -> if null ns then return () else do
    forM_ (tail ns) $ \n -> let d = abs (head ns - n)
                            in readArray a d >>= writeArray a d . succ
  let threshold = k * (k+1) `div` 2
      validate m = go m 0 where
        go _ c | c > threshold = validate (m+1)
        go i _ | i > 1000000 = return m
        go i c = do
          c' <- readArray a i
          go (i+m) (c+c')
  validate (n-k)

-}


You have a Petri dish with bacteria and you are preparing to dive into the harsh micro-world. But, unfortunately, you don't have any microscope nearby, so you can't watch them.You know that you have $$$n$$$ bacteria in the Petri dish and size of the $$$i$$$-th bacteria is $$$a_i$$$. Also you know intergalactic positive integer constant $$$K$$$.The $$$i$$$-th bacteria can swallow the $$$j$$$-th bacteria if and only if $$$a_i > a_j$$$ and $$$a_i \le a_j + K$$$. The $$$j$$$-th bacteria disappear, but the $$$i$$$-th bacteria doesn't change its size. The bacteria can perform multiple swallows. On each swallow operation any bacteria $$$i$$$ can swallow any bacteria $$$j$$$ if $$$a_i > a_j$$$ and $$$a_i \le a_j + K$$$. The swallow operations go one after another.For example, the sequence of bacteria sizes $$$a=[101, 53, 42, 102, 101, 55, 54]$$$ and $$$K=1$$$. The one of possible sequences of swallows is: $$$[101, 53, 42, 102, \underline{101}, 55, 54]$$$ $$$\to$$$ $$$[101, \underline{53}, 42, 102, 55, 54]$$$ $$$\to$$$ $$$[\underline{101}, 42, 102, 55, 54]$$$ $$$\to$$$ $$$[42, 102, 55, \underline{54}]$$$ $$$\to$$$ $$$[42, 102, 55]$$$. In total there are $$$3$$$ bacteria remained in the Petri dish.Since you don't have a microscope, you can only guess, what the minimal possible number of bacteria can remain in your Petri dish when you finally will find any microscope.

The first line contains two space separated positive integers $$$n$$$ and $$$K$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le K \le 10^6$$$) — number of bacteria and intergalactic constant $$$K$$$. The second line contains $$$n$$$ space separated integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^6$$$) — sizes of bacteria you have.

Print the only integer — minimal possible number of bacteria can remain.

NoteThe first example is clarified in the problem statement.In the second example an optimal possible sequence of swallows is: $$$[20, 15, 10, 15, \underline{20}, 25]$$$ $$$\to$$$ $$$[20, 15, 10, \underline{15}, 25]$$$ $$$\to$$$ $$$[20, 15, \underline{10}, 25]$$$ $$$\to$$$ $$$[20, \underline{15}, 25]$$$ $$$\to$$$ $$$[\underline{20}, 25]$$$ $$$\to$$$ $$$[25]$$$.In the third example no bacteria can swallow any other bacteria.

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

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

main = interact solve

mtrace _ s = s

solve input = show (total - removed)
    where
        n:k:xs = map fastRead . words $ input :: [Int64]
        sortedXs = sortBy (flip compare) xs
        first:_ = sortedXs
        total = fromIntegral(length xs) :: Int64
        (removed, _, _) = foldl' reducer (0, first, first) sortedXs

        reducer :: (Int64, Int64, Int64) -> Int64 -> (Int64, Int64, Int64)
        reducer (answer, firstValue, minOne) currentValue
            | firstValue > currentValue && minOne <= currentValue + k = mtrace debugTrace (answer + 1, firstValue, currentValue)
            | otherwise = mtrace ("Not " ++ debugTrace) (answer, currentValue, currentValue)
            where
                debugTrace = show firstValue ++ " And " ++ show currentValue ++ " And " ++ show minOne

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

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word
--import           Debug.Trace

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

solve :: Int -> [Int] -> Int
solve k0 xs0 = go 0 . group . map fromIntegral $ sort xs0
  where
    k :: Int64
    !k = fromIntegral k0
--    go res xs | traceShow xs False = undefined
    go !res (xs@(x:_):ys@(y:_):xss)
      | y <= x + k = go res (ys:xss)
      | otherwise = go (res + length xs) (ys:xss)
    go res xs = res + length (concat xs)

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [Int]
readInts = map parse . C8.words
  where parse s = let Just(x,_) = C8.readInt s in x

main :: IO ()
main = do
  [n,k] <- fmap (map read . words) getLine
  bs <- input
  let weights = readInts bs
      len = length weights
      sorted = List.sort weights
      sortedA = sorted
      sortedKA = [(w + k) | w <- sorted]
      (_,acc) = foldl eat (sortedKA,0) sortedA
        where eat (arr,acc) weight = let
                middleFront = List.dropWhile (< weight) arr
                (middle,front) = List.span (< weight + k) middleFront
                in (front, acc + (length middle))
  print $ (length weights) - acc

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

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

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

solve :: Int -> [Int] -> Int
solve k0 xs0 = go 0 . map fromIntegral $ sort xs0
  where
    k :: Int64
    !k = fromIntegral k0
    go !res (x:y:xs)
      | x < y, y <= x + k = go res (y:xs)
      | otherwise = go (res + 1) (y:xs)
    go res _ = res

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [Int]
readInts = map parse . C8.words
  where parse s = let Just(x,_) = C8.readInt s in x

main :: IO ()
main = do
  [n,k] <- fmap (map read . words) getLine
  bs <- input
  let weights = readInts bs
      weightsPlusK = Set.fromList [(w + k) | w <- weights]
      weightsSorted = List.sort weights
      remaining = foldl eat weightsPlusK weightsSorted
        where eat set weight = let
                (ok,notOk) = Set.partition
                  (\el -> el >= weight && el < (weight + k)) set
                in set Set.\\ ok
  print $ Set.size remaining


A permutation of length $$$n$$$ is a sequence of integers from $$$1$$$ to $$$n$$$ of length $$$n$$$ containing each number exactly once. For example, $$$[1]$$$, $$$[4, 3, 5, 1, 2]$$$, $$$[3, 2, 1]$$$ are permutations, and $$$[1, 1]$$$, $$$[0, 1]$$$, $$$[2, 2, 1, 4]$$$ are not.There was a permutation $$$p[1 \dots n]$$$. It was merged with itself. In other words, let's take two instances of $$$p$$$ and insert elements of the second $$$p$$$ into the first maintaining relative order of elements. The result is a sequence of the length $$$2n$$$.For example, if $$$p=[3, 1, 2]$$$ some possible results are: $$$[3, 1, 2, 3, 1, 2]$$$, $$$[3, 3, 1, 1, 2, 2]$$$, $$$[3, 1, 3, 1, 2, 2]$$$. The following sequences are not possible results of a merging: $$$[1, 3, 2, 1, 2, 3$$$], [$$$3, 1, 2, 3, 2, 1]$$$, $$$[3, 3, 1, 2, 2, 1]$$$.For example, if $$$p=[2, 1]$$$ the possible results are: $$$[2, 2, 1, 1]$$$, $$$[2, 1, 2, 1]$$$. The following sequences are not possible results of a merging: $$$[1, 1, 2, 2$$$], [$$$2, 1, 1, 2]$$$, $$$[1, 2, 2, 1]$$$.Your task is to restore the permutation $$$p$$$ by the given resulting sequence $$$a$$$. It is guaranteed that the answer exists and is unique.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 400$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 50$$$) — the length of permutation. The second line of the test case contains $$$2n$$$ integers $$$a_1, a_2, \dots, a_{2n}$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the array $$$a$$$ represents the result of merging of some permutation $$$p$$$ with the same permutation $$$p$$$.

For each test case, print the answer: $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$), representing the initial permutation. It is guaranteed that the answer exists and is unique.

import Data.List
import qualified Data.Set as Set

main = do
    contents <- getContents
    let notnull = filter (not . null) $ lines contents
    let input = map (map (read :: String -> Int) . words) notnull
    let res = go (drop 1 input)
    sequence res

toString :: [Int] -> String
toString [] = ""
toString (x:xs) = show x ++ " " ++ toString xs

go :: [[Int]] -> [IO ()]
go [] = []
go (_:x:xs) = putStrLn res:go xs
    where res = toString (solve x)

solve :: [Int] -> [Int]
solve a =
    let recurse [] _ = []
        recurse (x:xs) s
            | Set.member x s = recurse xs s
            | otherwise = x:recurse xs (Set.insert x s)
    in recurse a Set.empty

module Main where
import Data.List

main = do
  interact $ unlines . map solve . groupl 2 . tail .lines

solve :: [String] -> String
solve (n:str:[]) = unwords . map show $ (go (toInteger $ length . words $ str) [] (map read $ words str :: [Integer]))
  where go :: Integer -> [Integer] -> [Integer] -> [Integer]
        go 0 xs ls = xs
        go n xs (l:ls) = case elem l xs of
                           True -> go (n-1) xs ls
                           False -> go (n-1) (xs ++ [l]) ls

groupl :: Int -> [a] -> [[a]]
groupl _ [] = []
groupl n l
  | n > 0 = (take n l) : (groupl n (drop n l))
  | otherwise = error "Negative or zero n"

main = interact $ unlines . map (unwords . solve []) . prepareInput . map words . tail . lines

prepareInput :: [[String]] -> [[String]]
prepareInput [] = []
prepareInput (x:[]) = []
prepareInput (x:y:xs) = concat [[x ++ y], prepareInput xs]

solve :: [String] -> [String] -> [String]
solve xs (x:[]) = xs
solve xs (x:y:ys)
  | length xs == read x = xs
  | elem y xs = solve xs (x:ys)
  | otherwise = solve (xs ++ [y]) (x:ys)

import Data.Set as Set ( empty, insert, member )
import Control.Monad ( replicateM_ )

solve :: [Integer] -> [Integer]
solve = snd . foldr go (Set.empty, []) where
  go y old@(seen, ys)
    | member y seen = old
    | otherwise     = (insert y seen, y : ys)

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n $ getLine >> getLine >>= putStrLn . unwords . map show . solve . map read . words

import Control.Monad   ( replicateM_ )

restorePerm :: [Integer] -> [Integer]-> [Integer]
restorePerm ys [] = reverse ys
restorePerm ys (x : xs)
  | elem x ys = restorePerm ys xs
  | otherwise = restorePerm (x : ys) xs

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n $ getLine >> getLine >>= solve
  where
    solve = putStrLn . unwords . map show . restorePerm [] . map read . words

module Main where

import Data.List
import Control.Monad (replicateM_)

f :: [Int] -> [Int]
f [] = []
f (x:xs) = x : f (delete x xs)

go :: IO ()
go = do
  _ <- getLine
  xs <- map read . words <$> getLine :: IO [Int]
  putStrLn . unwords . map show $ f xs

main :: IO ()
main = do
  n <- readLn :: IO Int
  replicateM_ n go

import Data.List
import Control.Monad

getTest :: IO [Int]
getTest = do
  _ <- getLine
  r <- getLine
  let
    r' = map read $ words r
  return r'

main :: IO ()
main = do
  n <- getLine
  let n' = (read n :: Int)
  tests <- replicateM n' getTest
  mapM_ (putStrLn . unwords . map show . nub) tests

module Main where

import qualified Data.Set as Set

main :: IO ()
main = do
    input <- getLine
    let n = (read input :: Int)
    sequence_ $ replicate n solve

listToString :: [Int] -> String
listToString [] = ""
listToString (x : xs) = (show x) ++ " " ++ (listToString xs)

printList :: [Int] -> IO ()
printList = putStrLn . listToString

getPerm :: Set.Set Int -> Set.Set Int -> [Int] -> [Int] -> [Int]
getPerm _ _ [] ans = ans
getPerm first second (x : xs) ans = case (Set.member x first, Set.member x second) of
                                        (False, False) -> getPerm (Set.insert x first) second xs (ans ++ [x])
                                        (True,  False) -> getPerm first (Set.insert x second) xs ans
                                        (False, True)  -> getPerm (Set.insert x first) second xs ans

solve :: IO ()
solve = do
    foo <- getLine
    input <- getLine
    let perm = map read (words input) :: [Int]
    printList $ getPerm Set.empty Set.empty perm []

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

process []  y = y
process (x:xs) y | elem x y = process xs y
                 | otherwise = process xs (x:y)

onecase = do
		getLine
		a<- map read <$> words <$> getLine ::IO [Int]
		putStrLn $ intercalate " " $ map show $ reverse $ process a []

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

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

process []  y = y
process (x:xs) y | elem x y = process xs y
                 | otherwise = process xs (x:y)

onecase = do
		getLine
		a<- map read <$> words <$> getLine ::IO [Int]
		putStrLn $ intercalate " " $ map show $ process a []

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


Do you know a story about the three musketeers? Anyway, you will learn about its origins now.Richelimakieu is a cardinal in the city of Bearis. He is tired of dealing with crime by himself. He needs three brave warriors to help him to fight against bad guys.There are n warriors. Richelimakieu wants to choose three of them to become musketeers but it's not that easy. The most important condition is that musketeers must know each other to cooperate efficiently. And they shouldn't be too well known because they could be betrayed by old friends. For each musketeer his recognition is the number of warriors he knows, excluding other two musketeers.Help Richelimakieu! Find if it is possible to choose three musketeers knowing each other, and what is minimum possible sum of their recognitions.

The first line contains two space-separated integers, n and m (3 ≤ n ≤ 4000, 0 ≤ m ≤ 4000) — respectively number of warriors and number of pairs of warriors knowing each other. i-th of the following m lines contains two space-separated integers ai and bi (1 ≤ ai, bi ≤ n, ai ≠ bi). Warriors ai and bi know each other. Each pair of warriors will be listed at most once.

If Richelimakieu can choose three musketeers, print the minimum possible sum of their recognitions. Otherwise, print "-1" (without the quotes).

NoteIn the first sample Richelimakieu should choose a triple 1, 2, 3. The first musketeer doesn't know anyone except other two musketeers so his recognition is 0. The second musketeer has recognition 1 because he knows warrior number 4. The third musketeer also has recognition 1 because he knows warrior 4. Sum of recognitions is 0 + 1 + 1 = 2.The other possible triple is 2, 3, 4 but it has greater sum of recognitions, equal to 1 + 1 + 1 = 3.In the second sample there is no triple of warriors knowing each other.

module Main where
import Control.Applicative
import Control.Monad
import Data.IntSet (IntSet, intersection)
import qualified Data.IntSet as IntSet
import Data.IntMap.Strict (IntMap, (!))
import qualified Data.IntMap.Strict as IntMap
import Data.List
import Data.Function
import Data.Maybe

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

full = flip (>>=) $ \x -> [x, reverse x]
groups = groupBy (on (==) head) . sort . full
set    = IntSet.fromList . map last
groupSet a = (head $ head a, set a)

makeSets::[[Int]] -> IntMap IntSet
makeSets =  IntMap.fromList . map groupSet . groups

makeGets pairs = let sets  = makeSets pairs
                     recs = IntSet.size <$> sets
                 in ((sets !), (recs ! ))

minOpt [] = Nothing
minOpt xs = Just $ minimum xs

minimumRec::(Int -> IntSet) -> (Int -> Int) -> [Int] -> Maybe Int
minimumRec known rec [x,y] = (\b -> b + rec x + rec y)  <$> bestCompanion where
  bestCompanion = minOpt $ map rec $ IntSet.toList $ known x `intersection` known y

best::[[Int]] -> Maybe Int
best knows = minOpt $ catMaybes $ map minRec knows where minRec = uncurry minimumRec $ makeGets knows

main = do
  [_n, m] <- readLst
  knows <- replicateM m readLst
  print $ maybe (-1) (subtract 6) $ best knows


Anfisa the monkey learns to type. She is yet unfamiliar with the "space" key and can only type in lower-case Latin letters. Having typed for a fairly long line, Anfisa understood that it would be great to divide what she has written into k lines not shorter than a and not longer than b, for the text to resemble human speech more. Help Anfisa.

The first line contains three integers k, a and b (1 ≤ k ≤ 200, 1 ≤ a ≤ b ≤ 200). The second line contains a sequence of lowercase Latin letters — the text typed by Anfisa. It is guaranteed that the given line is not empty and its length does not exceed 200 symbols.

Print k lines, each of which contains no less than a and no more than b symbols — Anfisa's text divided into lines. It is not allowed to perform any changes in the text, such as: deleting or adding symbols, changing their order, etc. If the solution is not unique, print any of them. If there is no solution, print "No solution" (without quotes).

main = interact solve
solve input = output where
  [l0,l1] = lines input
  [k,a,b] = map (read::String->Int) $ words l0
  output = answer
  len = length l1
  answer = if len < k*a || len > k*b then "No solution" else unlines $ ans0 ++ ans1
  len0 = div len k
  mod0 = mod len k
  ans0 = [take (len0+1) $ drop (i*(len0+1)) l1|i<-[0..(mod0 - 1)]]
  ans1 = [take len0 $ drop (mod0*(len0+1)+i*len0) l1|i<-[0..(k-mod0-1)]]

main = interact solve
solve input = output where
  [l0,l1] = lines input
  [k,a,b] = map (read::String->Int) $ words l0
  len = length l1
  output = if len < k*a || len > k*b then "No solution" else unlines $ ans0 ++ ans1
  len0 = div len k
  mod0 = mod len k
  ans0 = [take (len0+1) $ drop (i*(len0+1)) l1|i<-[0..(mod0 - 1)]]
  ans1 = [take len0 $ drop (mod0*(len0+1)+i*len0) l1|i<-[0..(k-mod0-1)]]


You are given an integer $$$n$$$ and an array $$$a_1, a_2, \ldots, a_n$$$. You should reorder the elements of the array $$$a$$$ in such way that the sum of $$$\textbf{MEX}$$$ on prefixes ($$$i$$$-th prefix is $$$a_1, a_2, \ldots, a_i$$$) is maximized.Formally, you should find an array $$$b_1, b_2, \ldots, b_n$$$, such that the sets of elements of arrays $$$a$$$ and $$$b$$$ are equal (it is equivalent to array $$$b$$$ can be found as an array $$$a$$$ with some reordering of its elements) and $$$\sum\limits_{i=1}^{n} \textbf{MEX}(b_1, b_2, \ldots, b_i)$$$ is maximized.$$$\textbf{MEX}$$$ of a set of nonnegative integers is the minimal nonnegative integer such that it is not in the set.For example, $$$\textbf{MEX}(\{1, 2, 3\}) = 0$$$, $$$\textbf{MEX}(\{0, 1, 2, 4, 5\}) = 3$$$.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 100)$$$  — the number of test cases. The first line of each test case contains a single integer $$$n$$$ $$$(1 \le n \le 100)$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ $$$(0 \le a_i \le 100)$$$.

For each test case print an array $$$b_1, b_2, \ldots, b_n$$$  — the optimal reordering of $$$a_1, a_2, \ldots, a_n$$$, so the sum of $$$\textbf{MEX}$$$ on its prefixes is maximized. If there exist multiple optimal answers you can find any.

-- import Debug.Trace

import Data.List

type InType  = [Int]
type OutType = [Int]

inpLines :: Int
inpLines = 2

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

countOccs :: Eq a => [a] -> [(a, Int)]
countOccs [] = []
countOccs (x : xs) =
    case countOccs xs of
        (a,b) : t -> if x == a
                     then (a, b + 1) : t
                     else (x, 1) : (a, b) : t
        []         -> [(x, 1)]

solve :: InType -> OutType
solve a = map fst occ ++ gen occ
    where sa  = sort a
          occ = countOccs sa
          gen [] = []
          gen ((x, o) : t) = replicate (o - 1) x ++ gen t

receive :: [String] -> InType
receive [n, a] = toArr a
receive _      = undefined

main :: IO ()
main = interact (unlines . map (showArr . solve . receive) . chunksOf inpLines . tail . lines)
    where showArr = foldr (\x xs -> show x ++ " " ++ xs) ""

-- import Debug.Trace

import Data.List

type InType  = [Int]
type OutType = [Int]

inpLines :: Int
inpLines = 2

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

countOccs :: Eq a => [a] -> [(a, Int)]
countOccs [] = []
countOccs [x] = [(x, 1)]
countOccs (x : xs) =
    case countOccs xs of
        (a,b) : t -> if x == a
                     then (a, b + 1) : t
                     else (x, 1) : (a, b) : t
        _         -> undefined

solve :: InType -> OutType
solve a = map fst occ ++ gen occ
    where sa  = sort a
          occ = countOccs sa
          gen [] = []
          gen ((x, o) : t) = replicate (o - 1) x ++ gen t

receive :: [String] -> InType
receive [n, a] = toArr a
receive _      = undefined

main :: IO ()
main = interact (unlines . map (showArr . solve . receive) . chunksOf inpLines . tail . lines)
    where showArr = foldr (\x xs -> show x ++ " " ++ xs) ""

-- import Debug.Trace

import Data.List

type InType  = [Int]
type OutType = [Int]

inpLines :: Int
inpLines = 2

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

countOccs :: Eq a => [a] -> [(a, Int)]
countOccs [] = []
countOccs [x] = [(x, 1)]
countOccs (x : xs) = if x == (fst . head) rest
                     then addOne rest
                     else (x, 1) : rest
    where rest = countOccs xs
          addOne ((a, b) : t) = (a, b + 1) : t

solve :: InType -> OutType
solve a = map fst occ ++ gen occ
    where sa  = sort a
          occ = countOccs sa
          gen [] = []
          gen ((x, o) : t) = replicate (o - 1) x ++ gen t

receive :: [String] -> InType
receive [n, a] = toArr a

main :: IO ()
main = interact (unlines . map (showArr . solve . receive) . chunksOf inpLines . tail . lines)
    where showArr = foldr (\x xs -> show x ++ " " ++ xs) ""

import Control.Monad
import Data.List

main = do
    t <- getLine
    replicateM (read t) testcase

testcase :: IO ()
testcase = do
    n <- getLine
    a <- fmap words getLine
    putStrLn $ solve a

solve :: [String] -> String
solve a = unwords . map show $ solution
    where
        sorted = group . reverse . sort . map read $ a :: [[Int]]
        pairs = foldl (\(x,y) curr -> (head curr:x, tail curr ++ y)) ([],[]) sorted :: ([Int],[Int])
        solution = fst pairs ++ snd pairs :: [Int]

import qualified Data.Set as Set
import Data.List
import Control.Monad
import Data.Char

readInts = fmap (map read.words) getLine :: IO [Integer]

print2 [x] = ""
print2 (x:xs) = (if x == head xs then show(x) ++ " " else "") ++ print2 xs

print1 [x] = show(x) ++" "
print1 (x:xs) =  (if (x /= head xs) then show(x) ++ " " else "")  ++ print1 xs

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let sorted = sort a
    putStr $ print1 sorted
    putStrLn $ print2 sorted

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

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Char
import Data.List (sort)
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace
import System.IO
import Text.Read

main :: IO ()
main = do
  t <- readLn :: IO Integer
  forM_ [1 .. t] handleCase

handleCase :: Integer -> IO ()
handleCase c = do
  n <- read <$> getLine :: IO Int
  as <- fmap (map read . words) getLine :: IO [Int]
  putStrLn $ unwords $ map show $ solve (sort as) [] []

solve :: [Int] -> [Int] -> [Int] -> [Int]
solve [x] pref suff = reverse pref ++ [x] ++ suff
solve (x:y:as) pref suff
  | x==y = solve (x:as) pref (y:suff)
  | otherwise = solve (y:as) (x:pref) suff

module Main where

import Data.List (group)
import Control.Monad (replicateM_)
main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

solve :: IO ()
solve = do
  _ <- getLine
  arr <- map read . words <$> getLine
  putStrLn . unwords . map show . reorder $ arr

reorder :: [Int] -> [Int]
reorder = f 0  where
  f x arr = case splitBy x arr of
    Nothing -> arr
    Just (a,b,c) -> b : f (x + 1) (a ++ c)

splitBy :: Int -> [Int] -> Maybe ([Int], Int, [Int])
splitBy x [] = Nothing
splitBy x (r:rs) | x == r = Just ([],r,rs)
splitBy x (r:rs) = (\(a,b,c) -> (r:a,b,c)) <$> splitBy x rs

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

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

import Data.Array.Unboxed

solve :: [Int] -> [Int]
solve li = let
  k = maximum li
  buckets :: UArray Int Int
  buckets = accumArray (const . (+ 1)) 0 (0, k) $ zip li $ repeat ()
  in  [ix | (ix, ct) <- assocs buckets, ct > 0] ++ do
  (ix, ct) <- assocs buckets
  guard $ ct > 0
  replicate (ct - 1) ix

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    putInts $ solve a

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