On a circle lie $$$2n$$$ distinct points, with the following property: however you choose $$$3$$$ chords that connect $$$3$$$ disjoint pairs of points, no point strictly inside the circle belongs to all $$$3$$$ chords. The points are numbered $$$1, \, 2, \, \dots, \, 2n$$$ in clockwise order.Initially, $$$k$$$ chords connect $$$k$$$ pairs of points, in such a way that all the $$$2k$$$ endpoints of these chords are distinct.You want to draw $$$n - k$$$ additional chords that connect the remaining $$$2(n - k)$$$ points (each point must be an endpoint of exactly one chord).In the end, let $$$x$$$ be the total number of intersections among all $$$n$$$ chords. Compute the maximum value that $$$x$$$ can attain if you choose the $$$n - k$$$ chords optimally.Note that the exact position of the $$$2n$$$ points is not relevant, as long as the property stated in the first paragraph holds.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 100$$$, $$$0 \le k \le n$$$) — half the number of points and the number of chords initially drawn. Then $$$k$$$ lines follow. The $$$i$$$-th of them contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, \, y_i \le 2n$$$, $$$x_i \ne y_i$$$) — the endpoints of the $$$i$$$-th chord. It is guaranteed that the $$$2k$$$ numbers $$$x_1, \, y_1, \, x_2, \, y_2, \, \dots, \, x_k, \, y_k$$$ are all distinct.

For each test case, output the maximum number of intersections that can be obtained by drawing $$$n - k$$$ additional chords.

NoteIn the first test case, there are three ways to draw the $$$2$$$ additional chords, shown below (black chords are the ones initially drawn, while red chords are the new ones):  We see that the third way gives the maximum number of intersections, namely $$$4$$$.In the second test case, there are no more chords to draw. Of course, with only one chord present there are no intersections.In the third test case, we can make at most one intersection by drawing chords $$$1-3$$$ and $$$2-4$$$, as shown below:

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    pts <- replicateM k $ do
      [xi, yi] <- readInts
      pure (xi, yi)
    let
      vis :: UArray Int Bool
      vis = accumArray (\_ _ -> True) False (1, 2*n) $ do
        (xi, yi) <- pts
        [(xi, ()), (yi, ())]
      unvis :: [Int]
      unvis = [i | (i, False) <- assocs vis]
      newpts = zip unvis $ drop (n-k) unvis
      allpts = [(min x y, max x y) | (x, y) <- pts ++ newpts]
      crossings = do
        (x, y) <- allpts
        (p, q) <- allpts
        guard $ x < p -- no double-counting
        guard $ not $ (x < p && q < y) -- not nested
        guard $ not (y < p) -- not disjoint, either -- How did I forget?
        pure [x, y, p, q]
    putInts [length crossings] -- Why is this Wrong Answer??

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

import Control.Monad
import Data.List
import qualified Data.IntSet as IS

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    a <- replicateM k $ sort <$> readMany :: IO [[Int]]
    let b = uncurry (zipWith (\x y -> [x, y])) $ splitAt (n - k) rem where
            rem = filter (`IS.notMember` used) [1..2*n]
            used = IS.fromList $ concat a
        isect [_, b] [c, d] = c < b && b < d
    print $ sum [1 | (x:ys) <- tails $ sort $ a ++ b, y <- ys, isect x y]

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

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

{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List (sort)
import Data.Array.Unboxed (accumArray, array, UArray)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  n <- int
  xys <- numberOf (pair int int)
  return . show $ solve n xys

solve :: Int -> [(Int, Int)] -> Int
solve n xys = length [True | p <- ps, q <- ps, overlap p q] `div` 2
  where
    used = sort . uncurry (++) $ unzip xys
    unused = [1..2*n] `lsub` used
    s = length unused `div` 2
    (ls, rs) = splitAt s unused
    ps = sortP <$> xys ++ zip ls rs

overlap (x, y) (a, b) = (x < a && a < y && y < b) || (a < x && x < b && b < y)

sortP :: Ord a => (a, a) -> (a, a)
sortP (x, y) = if x <= y then (x, y) else (y, x)

lsub :: Eq a => [a] -> [a] -> [a]
lsub [] _ = []
lsub xs [] = xs
lsub (x:xs) (y:ys) = if x == y then lsub xs ys else x : lsub xs (y:ys)
-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, k] <- readInts
    pts <- replicateM k $ do
      [xi, yi] <- readInts
      pure (xi, yi)
    let
      vis :: UArray Int Bool
      vis = accumArray (\_ _ -> True) False (1, 2*n) $ do
        (xi, yi) <- pts
        [(xi, ()), (yi, ())]
      unvis :: [Int]
      unvis = [i | (i, False) <- assocs vis]
      newpts = zip unvis $ drop (n-k) unvis
      allpts = [(min x y, max x y) | (x, y) <- pts ++ newpts]
      crossings = do
        (x, y) <- allpts
        (p, q) <- allpts
        guard $ x < p -- no double-counting
        guard $ not $ (x < p && q < y) || (p < x && y < q) -- not nested
        pure [x, y, p, q]
   -- putInts unvis
   -- forM_ allpts $ \(x, y) -> putInts [x, y]
    putInts [length crossings] -- Why is this Wrong Answer??
   -- forM_ crossings putInts
   -- putInts []

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


At many competitions that have a word «cup» in its official name the winner is presented with an actual cup. This time the organizers of one unusual programming competition have decided to please the winner even more and to add a nameplate to the cup with the handle of the winner.The nameplate is to be rectangular and the text on it will be printed as a table of several rows and columns. Having some measurements done, the organizers have found out that the number $$$a$$$ of rows cannot be greater than $$$5$$$ while the number $$$b$$$ of columns cannot exceed $$$20$$$. Every cell of the table will contain either an asterisk («*») or a letter of user's handle.Furthermore, the organizers want the rows of the table to be uniform, which means that the number of asterisks used in different rows should differ by at most one (i.e. you can't have two asterisks in the first row and none in the second). The main goal, however, is to obtain the winner's handle precisely when reading the table from top to bottom and from left to right in every row (skipping asterisks).The organizers want for the nameplate to have as few rows as possible and among all valid tables with the minimum number of rows they want to choose the one that has the minimum number of columns.The winner is not yet determined so your task is to write a program that, given a certain handle, generates the necessary table.

The only line contains one string $$$s$$$ ($$$1 \le |s| \le 100$$$), comprised of uppercase and lowercase Latin letters,  — the handle of the winner.

In the first line output the minimum number $$$a$$$ of rows in the table and the minimum number $$$b$$$ of columns in an optimal table with rows. The following $$$a$$$ lines should contain $$$b$$$ characters each  — any valid table.

3 15
MyNameIsLifeIAm
ForeverByYourSi
deMyNameIsL*ife

import Data.List

f ::Int->Int->String->[String]
f _ _ ""=[]
f n 0 str=(take n str):f n 0 (drop n str)
f n m str=((take (n-1) str)++"*"):f n (m-1) (drop (n-1) str)

main = do
       e<-getLine
       let t=(length e)
           (r,c,a)=head $ sort [(r,c,r*c-t)|r<-[1..5],c<-[1..20],r*c>=t,r*c-t<=r]
       putStrLn $ (show r)++" "++(show c)
       mapM_ putStrLn $ f c a e

import Data.List

pingo b culo concha [] = ""
pingo b culo concha s =
	let q = culo + (if concha > 0 then 1 else 0) in
	let t = take (b-q) s in
	t++(replicate q '*')++"\n"++(pingo b culo (concha-1) $ drop (b-q) s)

solve::String -> String
solve ss =
	let s = head $ words ss in
	let n = length s in
	let a = div (n+19) 20 in
	let b = div (n+a-1) a in
	let z = a*b-n in
	let culo = div z a in
	let concha = mod z a in
	show(a)++" "++show(b)++"\n"++pingo b culo concha s

main = do
  interact $ solve

import Data.List

pingo b [] = ""
pingo b s =
	let t = take b s in
	t++"\n"++(pingo b $ drop b s)

solve::String -> String
solve ss =
	let s = head $ words ss in
	let n = length s in
	let a = div (n+19) 20 in
	let b = div (n+a-1) a in
	let s2 = s ++ (replicate (a*b-n) '*') in
	show(a)++" "++show(b)++"\n"++pingo b s2

main = do
  interact $ solve


Simon has a prime number x and an array of non-negative integers a1, a2, ..., an.Simon loves fractions very much. Today he wrote out number  on a piece of paper. After Simon led all fractions to a common denominator and summed them up, he got a fraction: , where number t equals xa1 + a2 + ... + an. Now Simon wants to reduce the resulting fraction. Help him, find the greatest common divisor of numbers s and t. As GCD can be rather large, print it as a remainder after dividing it by number 1000000007 (109 + 7).

The first line contains two positive integers n and x (1 ≤ n ≤ 105, 2 ≤ x ≤ 109) — the size of the array and the prime number. The second line contains n space-separated integers a1, a2, ..., an (0 ≤ a1 ≤ a2 ≤ ... ≤ an ≤ 109).

Print a single number — the answer to the problem modulo 1000000007 (109 + 7).

NoteIn the first sample . Thus, the answer to the problem is 8.In the second sample, . The answer to the problem is 27, as 351 = 13·27, 729 = 27·27.In the third sample the answer to the problem is 1073741824 mod 1000000007 = 73741817.In the fourth sample . Thus, the answer to the problem is 1.

module Main where

import Data.List

getPows :: [Integer] -> Integer -> [Integer]
getPows lst sum = map (\x -> sum - x) lst

getIt :: [Integer] -> [(Integer, Integer)]
getIt (x:xs) = getPairLst xs 1 x

getPairLst :: [Integer] -> Integer -> Integer -> [(Integer, Integer)]
getPairLst [] numb curr = [(curr, numb)]
getPairLst (x:xs) numb curr = case (x == curr) of
                               (True) -> getPairLst xs (numb+1) curr
                               (False)-> (curr, numb) : getPairLst xs 1 x

giveNAnswer :: [(Integer, Integer)] -> Integer -> Integer
giveNAnswer (x:xs) prime = case ((snd x `mod` prime) == 0) of
                            (False) -> fst x
                            (True)  -> giveNAnswer (addLst xs ((fst x)+1) (snd x `div` prime )) prime

addLst :: [(Integer, Integer)] -> Integer -> Integer -> [(Integer, Integer)]
addLst [] fstX sndX = [(fstX, sndX)]
addLst (x:xs) fstX sndX = case (fstX == fst x) of
                            (True)  -> (fst x, (snd x)+sndX) : xs
                            (False) -> (fstX, sndX) :x: xs

powIt :: Integer -> Integer ->Integer
powIt _ 0 = 1
powIt based x = case (x `mod` 2) of
                    1 -> mod (based * (powIt based (x-1))) 1000000007
                    0 -> let r = powIt based (x `div` 2)
                         in mod (r*r) 1000000007

main :: IO()
main = do
        line1 <- getLine
        line2 <- getLine
        let [n,prime] = map read (words line1)
        let arr = map (read) (words line2)
        let sm = sum arr
        let ans = getIt $(sort (getPows arr sm))
        let x = min (giveNAnswer ans prime) sm
        print $ powIt prime x

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . 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)
itof :: Int -> Double
itof = fromIntegral

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

main = do
    [n,x] <- readLns
    as <- readInts
    print $ solve n x as

modulo = 1000000007

newtype Modulo = Modulo { getInteger :: Integer } deriving(Eq,Ord)
instance Num Modulo where
    Modulo a + Modulo b = Modulo ((a+b) `mod` modulo)
    Modulo a - Modulo b = Modulo ((a-b) `mod` modulo)
    Modulo a * Modulo b = Modulo ((a*b) `mod` modulo)
    abs (Modulo a) = Modulo (abs a)
    signum (Modulo a) = Modulo (signum a)
    fromInteger i = Modulo i

instance Show Modulo where
    show (Modulo i) = show i

solve :: Int -> Int -> [Int] -> Modulo
solve n x' as' = go bs
    where
    as = map fromIntegral as' :: [Integer]
    s = sum as
    x = fromIntegral x'
    bs = [(s - b,1) | b <- reverse as]
    go l | k1 `mod` x == 0 = go ((b+1,k1 `div` x):l2)
         | otherwise = Modulo x ^ min b s
        where
        (b,_) = head l
        (l1,l2) = span ((==b).fst) l
        k1 = sum $ map snd l1

import Data.List as List

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

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

g :: Integer -> Integer -> Integer -> [Integer] -> Integer
g _ 0 _ _ = 0
g x s offset as@(a:_) =
  if offset/=a
  then a-offset + (g x (s-a+offset) a as)
  else
      let k = length $ head $ List.group as in
      if mod (fromIntegral k) x /=0
      then 0
      else g x s offset ((replicate (div k $ fromInteger x) (offset+1)) ++ (drop k as))

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let s = sum as'
  let as = map (s-) $ reverse $ List.sort as'
  print $ expmod 1 x $ g x s 0 as

module Main where

import Data.List

getPows :: [Integer] -> Integer -> [Integer]
getPows lst sum = map (\x -> sum - x) lst

getIt :: [Integer] -> [(Integer, Integer)]
getIt (x:xs) = getPairLst xs 1 x

getPairLst :: [Integer] -> Integer -> Integer -> [(Integer, Integer)]
getPairLst [] numb curr = [(curr, numb)]
getPairLst (x:xs) numb curr = case (x == curr) of
                               (True) -> getPairLst xs (numb+1) curr
                               (False)-> (curr, numb) : getPairLst xs 1 x

giveNAnswer :: [(Integer, Integer)] -> Integer -> Integer
giveNAnswer (x:xs) prime = case ((snd x `mod` prime) == 0) of
                            (False) -> fst x
                            (True)  -> giveNAnswer (addLst xs ((fst x)+1) (snd x `div` prime )) prime

addLst :: [(Integer, Integer)] -> Integer -> Integer -> [(Integer, Integer)]
addLst [] fstX sndX = [(fstX, sndX)]
addLst (x:xs) fstX sndX = case (fstX == fst x) of
                            (True)  -> (fst x, (snd x)+sndX) : xs
                            (False) -> (fst x, sndX) : xs

powIt :: Integer -> Integer ->Integer
powIt _ 0 = 1
powIt based x = case (x `mod` 2) of
                    1 -> mod (based * (powIt based (x-1))) 1000000007
                    0 -> let r = powIt based (x `div` 2)
                         in mod (r*r) 1000000007

main :: IO()
main = do
        line1 <- getLine
        line2 <- getLine
        let [n,prime] = map read (words line1)
        let arr = map (read) (words line2)
        let sm = sum arr
        let ans = getIt $(sort (getPows arr sm))
        let x = min (giveNAnswer ans prime) sm
        print $ powIt prime x

import Data.List as List

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

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  if n==225 && x==5 then
    print $ map (\lst->(head lst, length lst)) $ List.group as'
  else
    return ()
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  let result = expmod 1 x (r1+r2)
  --print (r1, r2, result)
  print result

import Data.List as List

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

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  if n==225 && x==5 then
    print $ map (\lst->(head lst, length lst)) $ List.group as'
  else
    return ()
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  let result = expmod 1 x (r1+r2)
  print (r1, r2, result)

import Data.List as List

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

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as
  print $ mod ((expmod 1 x (s-an)) * (gcd (expmod 1 x an) k)) modnum

import Data.List as List

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

modnum = 1000000007
expmod :: Integer -> Integer -> Integer -> Integer
expmod a _ 0 = mod a modnum
expmod a x n
 |even n = expmod a (mod (x*x) modnum) (div n 2)
 |otherwise = expmod (mod (a*x) modnum) x (n-1)

has :: Integer -> Integer -> Integer
has 0 _ = 0
has n x
 |mod n x == 0 = 1+(has (div n x) x)
 |otherwise = 0

main :: IO ()
main = do
  [n, x] <- fmap readInts getLine
  as' <- fmap readInts getLine
  let as = reverse $ List.sort as'
  let s = sum as
  let an = head as
  let k = fromIntegral $ length $ head $ List.group as

  let r1 = s-an
  let r2 = (min (has k x) an)
  print $ expmod 1 x (r1+r2)


Vasya, or Mr. Vasily Petrov is a dean of a department in a local university. After the winter exams he got his hands on a group's gradebook.Overall the group has n students. They received marks for m subjects. Each student got a mark from 1 to 9 (inclusive) for each subject.Let's consider a student the best at some subject, if there is no student who got a higher mark for this subject. Let's consider a student successful, if there exists a subject he is the best at.Your task is to find the number of successful students in the group.

The first input line contains two integers n and m (1 ≤ n, m ≤ 100) — the number of students and the number of subjects, correspondingly. Next n lines each containing m characters describe the gradebook. Each character in the gradebook is a number from 1 to 9. Note that the marks in a rows are not sepatated by spaces.

Print the single number — the number of successful students in the given group.

NoteIn the first sample test the student number 1 is the best at subjects 1 and 3, student 2 is the best at subjects 1 and 2, but student 3 isn't the best at any subject.In the second sample test each student is the best at at least one subject.

import Data.List

main :: IO()
main = print . solve . tail . lines =<< getContents

solve :: [String] -> Int
solve s = let s' = transpose s
              ms = map maximum s'
          in  length [x | x <- s, any (uncurry (==)) (zip x ms)]

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

poss :: [Int] -> [Int]
poss [] = []
poss lst = elemIndices mx lst
  where mx = maximum lst

toints :: [String] -> [[Int]]
toints = map . map $ digitToInt

calc :: [String] -> Int
calc = length . nub . foldl1 (++) . map poss . transpose . toints

main = do
  nm <- fmap words getLine
  let nmi = map (\x -> read x :: Int) nm
      n = nmi !! 0
      --m = nmi !! 1
  slist <- replicateM n getLine
  print $ calc slist

import List
import Data.Char
tapleMax ::(Int,Int) -> Int
tapleMax x | fst x >= snd x = fst x
           | otherwise = snd x
getMax ::[Int] -> [Int] -> [Int]
getMax a b = [tapleMax y|y <- getTaple a b]
getTaple ::[Int] -> [Int] ->[(Int,Int)]
getTaple [] [] = []
getTaple (x:xs) (y:ys) =(x,y):getTaple xs ys
getBest ::[[Int]] ->[Int]
getBest [x] = x
getBest (x:xs) = getMax x (getBest xs)
hasBest ::[Int] -> [Int] -> Bool
hasBest [] [] = False
hasBest (x:xs) (y:ys) | x<= y = True
                     | otherwise = hasBest xs ys
getAns ::[[Int]] -> Int
getAns a = length$filter (hasBest (getBest a)) a
main=interact$show.getAns.(map (map digitToInt)).(drop 2).words

import Array
import Char

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

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

toArray2 :: (Char -> e) -> [String] -> Array (Int, Int) e
toArray2 parser lines = array ((0, 0), (n-1, m-1))
    [((i, j), parser (lines !! i !! j)) | i <- [0..n-1], j <- [0..m-1]]
  where
    n = length lines
    m = length (head lines)

getArray2 :: (Char -> e) -> (Int, Int) -> IO (Array (Int, Int) e)
getArray2 parser (n, _) = getLines n >>= return . toArray2 parser

solve :: (Int, Int) -> Array (Int, Int) Int -> Int
solve (n, m) a  =  length (filter (\i -> any (\j -> a ! (i, j) == maximum (map (\k -> a ! (k,j)) [0..n-1])) [0..m-1]) [0..n-1])

main :: IO ()
main  =  do
    [n, m] <- Main.reads
    a <- getArray2 digitToInt (n, m)
    print $ solve (n, m) a

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  length.group.sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b && a /= 0 then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x

import List

solve :: [[Char]] -> Int
solve grades = let gradesT = transpose grades
                   ms = map maximum gradesT
                   isSuccessful ts = not $ null $ filter (\(x, y) -> x == y) $ zip ts ms
               in length $ filter isSuccessful grades

main = interact $ show . solve . drop 2 . words

import Data.List

test1 = ["223",
         "232",
         "112"]

test2 = ["91728",
         "11828",
         "11111"]

solve :: [[Char]] -> Int
solve grades = let gradesT = transpose grades
                   ms = map maximum gradesT
                   isSuccessful ts = not $ null $ filter (\(x, y) -> x == y) $ zip ts ms
               in length $ filter isSuccessful grades

main = interact $ show . solve . drop 2 . words

import Data.List
main=interact$show.f.tail.lines
f y=length[x|x<-y,any(uncurry(==))$zip x$map maximum$transpose y]

import Data.List (transpose)

main :: IO ()
main = getContents >>= print . solve . tail . lines

solve :: [String] -> Int
solve xss = length [ () | xs <- xss, any (uncurry (==)) $ zip xs (map maximum $ transpose xss) ]

import Data.List
main=interact$show.f.tail.lines
f y=length[()|x<-y,any(uncurry(==))$zip x(map maximum$transpose y)]

import Data.List
import Control.Monad
main = do
  [n,m] <- liftM (map read . words) getLine
  gs <- liftM transpose (replicateM n getLine)
  print $ length $ filter id $ foldr1 (zipWith (||)) $  map best gs
best gs = map (== maximum gs) gs

import Data.Char
import Data.List
main :: IO ()
main = interact work

work :: String -> String
work = (++"\n") . show . length . filter id . solve . map (map digitToInt) . tail . lines

solve :: [[Int]] -> [Bool]
solve x = map (calc $ transpose x) x

calc :: [[Int]] -> [Int] -> Bool
calc grades student = or $ zipWith (>=) student $ map maximum grades

import Data.Char
import Data.List
import Control.Applicative

main = do
  _ <- getLine
  nms <- map (map digitToInt) <$> lines <$> getContents
  print $ solve nms

solve :: [[Int]] -> Int
solve nms = length $ filter id $ map (p nms) nms
p nms ms = or $ zipWith (>=) ms $ map maximum $ transpose nms

main :: IO ()
main = interact solve

solve :: String -> String
solve xs = let
 lxs = lines xs
 top = words $ head lxs
 n = read $ head top
 m = read $ head $ drop 1 top
 rest = tail lxs
 dat = map (\x->map (read.return) x) rest
 in show $ ans (n,m,dat)

ans :: (Int,Int,[[Int]]) -> Int
ans (n,m,dat) = foldr (\x y->if x then y+1 else y) 0 $ map isSame [0..n-1] where
 isSame t = any (\x->dat!!t!!x == maxP x) [0..m-1]
 maxP t = foldr max 0 [ dat!!p!!t | p<-[0..n-1]]

import Data.List
bests xs = map fst.filter ((== mx).snd).zip [0..]$xs
	where mx = maximum xs
succesful = length.nub.concat.map bests
main=interact$show.succesful.transpose.tail.lines

import Control.Applicative
import Data.Char
import Data.List

process t = map (\z-> if z==ma then '1' else '0') t
	where ma= maximum t

myor a b = zipWith myor1 a b

myor1 '0' '0' = '0'
myor1 _ _ = '1'

main= do
	[n,m]<- map read.words <$> getLine ::IO [Int]
	s<- transpose. lines <$> getContents ::IO [String]
	let s1= foldl1 (myor) $ map process s
	print $ length $ filter (=='1') s1

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

readL :: Int -> IO [String]
readL n = sub n []
  where sub 0 l = return l
        sub n l = do ll <- getLine
                     sub (n-1) (l ++ [ll])

flatten :: [[a]] -> [a]
flatten [[]] = []
flatten ([]:ys) = flatten ys
flatten ((x:xs):ys) = x:(flatten (xs:ys))

rotate :: [String] -> [String]
rotate l = sub l []
  where sub l acc
          | flatten l == [] = acc
          | otherwise       = sub (map tail l) ((foldl (\ac x -> (head x):ac) "" l):acc)

getInt :: IO Int
getInt = readLn

cntList :: String -> [Int]
cntList str = sub '0' 0 str []
  where sub c idx [] l = l
        sub c idx (x:xs) l = if c < x then sub x (idx+1) xs [idx]
                             else if c == x then sub x (idx+1) xs (idx:l)
                                  else sub c (idx+1) xs l

main :: IO ()
main = do
  f <- getLine
  let ps = map (\x -> read x) (words f)
  cs <- readL $ head ps
  --putStrLn . show $ cs
  --putStrLn . show $ map cntList (rotate cs)
  putStrLn . show . length . nub . concat $ map cntList (rotate cs)
--  mapM (\x -> putStrLn x) $ rotate cs
  return ()

import Data.List
main=getLine >>= (\x -> (\[n,m] -> print.(slv n m).(map (\x -> map f x)).(take n).lines =<< getContents)(map read $ (words x)) )
f :: Char -> Int; f '0'=0; f '1'=1;f '2'=2; f '3'=3;f '4'=4; f '5'=5;f '6'=6; f '7'=7;f '8'=8; f '9'=9;
slv n m as = length $ filter (==True) $ map (\x -> g n m x (transpose as)) as
g n' m' s as = or $ [((s)!!m `best` (as!!m)) | m <- [0..(m'-1)], n <- [0..(n'-1)]]
best x xs = x >= maximum xs

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

transpose ([]:_) = []
transpose l =
    (map (\(x:xs) -> x) l) : (transpose (map (\(x:xs) -> xs) l))

find_best grades =
    [i | (i, x) <- zip [1..] grades, x == best]
    where best = maximum grades

solve grades n =
    let students = map find_best grades
        all_students = Set.unions $ map Set.fromList students
    in
      Set.size all_students

main = do
  (n:_) <- (getLine >>= return . map (read::String->Int) . words)
  xs <- forM [1..n] (\_ -> getLine >>= (return . map digitToInt))
  -- print $ transpose xs
  print $ solve (transpose xs) n

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  snd.foldl count (0,1).sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x

--import Data.Vector
import Numeric
import Data.List
main = do
 nm <- getLine
 cs <- getContents
 let (n:m:_) = map (fst.head.readDec) $ words nm
 print.answer (n,m).take n.lines $ cs

answer :: (Int,Int) -> [[Char]] -> Int
answer (n,m) xs =
 let xy = split n [(x,y) | x <- [0..m-1],y <- [0..n-1]]
 in  snd.foldl count (0,1).sort.concat $ map (f xs) xy
 where
  f :: [[Char]] -> [(Int,Int)] -> [Int]
  f xs xys = let grades = map (value xs) xys
                 maX = foldl max '1' grades
             in third.foldl g (maX ,0, []) $ grades
  g (a,k,success) b = if a == b then (a,k+1,k:success)
                                else (a,k+1,  success)

count (a,k) b = if a < b && a /= 0 then (b,k+1) else (a,k)

third (_,_,x) = x

split n [] = []
split n xs = a:split n b
 where
  (a,b) = splitAt n xs

value xs (x,y) = (xs !! y ) !! x


You are given a set of points on a straight line. Each point has a color assigned to it. For point a, its neighbors are the points which don't have any other points between them and a. Each point has at most two neighbors - one from the left and one from the right.You perform a sequence of operations on this set of points. In one operation, you delete all points which have a neighbor point of a different color than the point itself. Points are deleted simultaneously, i.e. first you decide which points have to be deleted and then delete them. After that you can perform the next operation etc. If an operation would not delete any points, you can't perform it.How many operations will you need to perform until the next operation does not have any points to delete?

Input contains a single string of lowercase English letters 'a'-'z'. The letters give the points' colors in the order in which they are arranged on the line: the first letter gives the color of the leftmost point, the second gives the color of the second point from the left etc. The number of the points is between 1 and 106.

Output one line containing an integer - the number of operations which can be performed on the given set of points until there are no more points to delete.

NoteIn the first test case, the first operation will delete two middle points and leave points "ab", which will be deleted with the second operation. There will be no points left to apply the third operation to.In the second test case, the first operation will delete the four points in the middle, leaving points "aa". None of them have neighbors of other colors, so the second operation can't be applied.

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import Data.List
import Data.Int
-- import Debug.Trace
import Control.DeepSeq

main = do
    input <- getLine
    putStrLn $ solve $ parse input

parse s =
    let convertToCount (x:xs) = (length xs + 1, x)
        doubleVal (a, b) = (2 * a, b)
    in  map convertToCount $ group s

solve = show . (numSteps 0)

numSteps :: Int -> [(Int, Char)] -> Int
-- numSteps s x | trace ("numsteps " ++ show s ++ " " ++ show x) False = undefined
numSteps s x =
    if (numLeft x)  <= 1
        then s
        else numSteps (s + reduceAmount) (performReduction x)
    where numLeft = length
          ceilDiv2 x = (x + 1) `div` 2
          -- we know length of input in following fn is > 1
          weight_minimum [x, y] = min x y
          weight_minimum (x:xs) = min x $ min (ceilDiv2 $ minimum $ init xs) (last xs)
          reduceAmount = weight_minimum (map fst x)

          sub_first s (a,b) = (a - s, b)
          weight_sub :: [(Int, a)] -> Int -> [(Int, a)]
          weight_sub (x:xs) s = (sub_first s x):(map (sub_first $ 2*s) $ init xs) ++ [sub_first s $ last xs]
          merge ((c1, a1):(c2, a2):xs) =
            if a1 == a2
                then merge ((c1 + c2, a1) : xs)
                else (c1, a1) : merge ((c2, a2) : xs)
          merge x = x
          performReduction x = merge $ filter ((>0) . fst) $ weight_sub x reduceAmount

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import Data.List
import Data.Int
-- import Debug.Trace
import Control.DeepSeq

main = do
    input <- getLine
    putStrLn $ solve $ parse input

parse s =
    let convertToCount (x:xs) = (length xs + 1, x)
        doubleVal (a, b) = (2 * a, b)
        fixEnds [a] = [a]
        fixEnds (x:xs) = (doubleVal x):(init xs) ++ [doubleVal (last xs)]
    in  fixEnds $ map convertToCount $ group s

solve = show . (numSteps 0)

numSteps :: Int -> [(Int, Char)] -> Int
-- numSteps s x | trace ("numsteps " ++ show s ++ " " ++ show x) False = undefined
numSteps s x =
    if (numLeft x)  <= 1
        then s
        else numSteps (s + addSteps) (performReduction x)
    where numLeft = length
          reduceAmount = minimum (map fst x)
          addSteps = (reduceAmount + 1) `div` 2
          merge ((c1, a1):(c2, a2):xs) =
            if a1 == a2
                then merge ((c1 + c2, a1) : xs)
                else (c1, a1) : merge ((c2, a2) : xs)
          merge x = x
          performReduction x = merge $ filter ((>0) . fst) $ map (\(a,b) -> (a - reduceAmount, b)) x

{-# LANGUAGE BangPatterns, ViewPatterns #-}
import Data.List
import Data.Int
import Control.DeepSeq

main = do
    input <- getLine
    putStrLn $ solve $ parse input

parse s =
    let convertToCount (x:xs) = (length xs + 1, x)
    in  map convertToCount $ group s

solve = show . (numSteps 0)

numSteps :: Int -> [(Int, Char)] -> Int
numSteps s x =
    if (numLeft x)  <= 1
        then s
        else numSteps (s + reduceAmount) (performReduction x)
    where numLeft = length
          reduceAmount = minimum (map fst x)
          merge ((c1, a1):(c2, a2):xs) =
            if a1 == a2
                then merge ((c1 + c2, a1) : xs)
                else (c1, a1) : merge ((c2, a2) : xs)
          merge x = x
          performReduction x = merge $ filter ((>0) . fst) $ map (\(a,b) -> (a - reduceAmount, b)) x


Vasya has his favourite number $$$n$$$. He wants to split it to some non-zero digits. It means, that he wants to choose some digits $$$d_1, d_2, \ldots, d_k$$$, such that $$$1 \leq d_i \leq 9$$$ for all $$$i$$$ and $$$d_1 + d_2 + \ldots + d_k = n$$$.Vasya likes beauty in everything, so he wants to find any solution with the minimal possible number of different digits among $$$d_1, d_2, \ldots, d_k$$$. Help him!

The first line contains a single integer $$$n$$$ — the number that Vasya wants to split ($$$1 \leq n \leq 1000$$$).

In the first line print one integer $$$k$$$ — the number of digits in the partition. Note that $$$k$$$ must satisfy the inequality $$$1 \leq k \leq n$$$. In the next line print $$$k$$$ digits $$$d_1, d_2, \ldots, d_k$$$ separated by spaces. All digits must satisfy the inequalities $$$1 \leq d_i \leq 9$$$. You should find a partition of $$$n$$$ in which the number of different digits among $$$d_1, d_2, \ldots, d_k$$$ will be minimal possible among all partitions of $$$n$$$ into non-zero digits. Among such partitions, it is allowed to find any. It is guaranteed that there exists at least one partition of the number $$$n$$$ into digits.

NoteIn the first test, the number $$$1$$$ can be divided into $$$1$$$ digit equal to $$$1$$$.In the second test, there are $$$3$$$ partitions of the number $$$4$$$ into digits in which the number of different digits is $$$1$$$. This partitions are $$$[1, 1, 1, 1]$$$, $$$[2, 2]$$$ and $$$[4]$$$. Any of these partitions can be found. And, for example, dividing the number $$$4$$$ to the digits $$$[1, 1, 2]$$$ isn't an answer, because it has $$$2$$$ different digits, that isn't the minimum possible number.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
-- import Data.List
-- import qualified Data.Vector.Unboxed as VU
-- import qualified Data.Vector.Unboxed.Mutable as VUM
-- import Control.Monad
-- import Control.Monad.ST
-- import Debug.Trace
-- trace _ = id

solve :: Int -> (Int, [Int])
solve n = (n, take n (repeat 1))

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

tmain :: B.ByteString -> (Int, [Int])
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_n]:remLines1 = remLines0
      n = readBInt bs_n
  in solve n

outAnswer :: (Int, [Int]) -> IO ()
outAnswer (n, xs) = do
  putStrLn $ show $ n
  putStrLn $ unwords $ map show $ xs

main :: IO ()
main = outAnswer . tmain =<< B.getContents

-- Codeforces Round #534 Div.2 (A), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  print $ n
  putStrLn $ intersperse ' ' $ replicate n '1'

main = do
  n <- readLn
  print n
  putStrLn $ unwords $ replicate n "1"

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

main = do
		n<-read<$> getLine ::IO Int
		print n
		putStrLn $ concat $ replicate n "1 "

process :: Int -> [Int]
process n = take n $ repeat 1

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    print n
    putStrLn.unwords.map show $ process n


Professor GukiZ is concerned about making his way to school, because massive piles of boxes are blocking his way. In total there are n piles of boxes, arranged in a line, from left to right, i-th pile (1 ≤ i ≤ n) containing ai boxes. Luckily, m students are willing to help GukiZ by removing all the boxes from his way. Students are working simultaneously. At time 0, all students are located left of the first pile. It takes one second for every student to move from this position to the first pile, and after that, every student must start performing sequence of two possible operations, each taking one second to complete. Possible operations are: If i ≠ n, move from pile i to pile i + 1; If pile located at the position of student is not empty, remove one box from it.GukiZ's students aren't smart at all, so they need you to tell them how to remove boxes before professor comes (he is very impatient man, and doesn't want to wait). They ask you to calculate minumum time t in seconds for which they can remove all the boxes from GukiZ's way. Note that students can be positioned in any manner after t seconds, but all the boxes must be removed.

The first line contains two integers n and m (1 ≤ n, m ≤ 105), the number of piles of boxes and the number of GukiZ's students.  The second line contains n integers a1, a2, ... an (0 ≤ ai ≤ 109) where ai represents the number of boxes on i-th pile. It's guaranteed that at least one pile of is non-empty.

In a single line, print one number, minimum time needed to remove all the boxes in seconds.

NoteFirst sample: Student will first move to the first pile (1 second), then remove box from first pile (1 second), then move to the second pile (1 second) and finally remove the box from second pile (1 second).Second sample: One of optimal solutions is to send one student to remove a box from the first pile and a box from the third pile, and send another student to remove a box from the third pile. Overall, 5 seconds.Third sample: With a lot of available students, send three of them to remove boxes from the first pile, four of them to remove boxes from the second pile, five of them to remove boxes from the third pile, and four of them to remove boxes from the fourth pile. Process will be over in 5 seconds, when removing the boxes from the last pile is finished.

module Main where

import Data.Int
import Data.Functor

scanArray :: IO [Int64]
scanArray = (map read . words) <$> getLine

-- Binary search to find the least x \in [l,r) such that f(x).
firstTrue :: (Integral a) => a -> a -> (a -> Bool) -> a
firstTrue l r f = if l == r then l else
  let m = (l + r) `div` 2 in
    if f m then firstTrue l m f else firstTrue (m + 1) r f

-- Can the task a be done in t time units.
canBeDone :: [Int64] -> Int64 -> Int64 -> Bool
canBeDone a n t = go (reverse a) n (t - l + 1) 0
  where l = fromIntegral $ length a

go [] _ _ _ = True
go (a:as) n t r
  | a /= 0 && t <= 0 = False
  | a <= r = go as n (t+1) (r-a)
  | otherwise = n >= (a - r + t - 1) `div` t && go as (n - (a - r) `div` t - isRem) (t+1) newR
  where (isRem, newR) = let r' = (a - r) `rem` t in if r' == 0 then (0, 0) else (1, t - r')

main = do
  [n, m] <- scanArray
  a <- scanArray
  print $ firstTrue 1 (10^15) (canBeDone (0:a) m)

module Main where

import Data.Int
import Data.Functor

scanArray :: IO [Int64]
scanArray = (map read . words) <$> getLine

-- Binary search to find the least x \in [l,r) such that f(x).
firstTrue :: (Integral a) => a -> a -> (a -> Bool) -> a
firstTrue l r f = if l == r then l else
  let m = (l + r) `div` 2 in
    if f m then firstTrue l m f else firstTrue (m + 1) r f

-- Can the task a be done in t time units.
canBeDone :: [Int64] -> Int64 -> Int64 -> Bool
canBeDone a n t = (t >= l) && go (reverse a) n (t - l + 1) 0
  where l = fromIntegral $ length a

go [] _ _ _ = True
go (a:as) n t r
  | a <= r = go as n (t+1) (r-a)
  | otherwise = n * t >= a - r && go as (n - (a - r) `div` t - isRem) (t+1) newR
  where (isRem, newR) = let r' = (a - r) `rem` t in if r' == 0 then (0, 0) else (1, t - r')

main = do
  [n, m] <- scanArray
  a <- scanArray
  print $ firstTrue 1 (10^15) (canBeDone (0:a) m)

module Main where

import Data.Int
import Data.Functor

scanArray :: IO [Int64]
scanArray = (map read . words) <$> getLine

-- Binary search to find the least x \in [l,r) such that f(x).
firstTrue :: (Integral a) => a -> a -> (a -> Bool) -> a
firstTrue l r f = if l == r then l else
  let m = (l + r) `div` 2 in
    if f m then firstTrue l m f else firstTrue (m + 1) r f

-- Can the task a be done in t time units.
canBeDone :: [Int64] -> Int64 -> Int64 -> Bool
canBeDone a n t = (t >= l) && go (reverse a) n (t - l + 1) 0
  where l = fromIntegral $ length a

go [] _ _ _ = True
go (a:as) n t r
  | a <= r = go as n (t+1) (r-a)
  | otherwise = n >= (a - r + t - 1) `div` t && go as (n - (a - r) `div` t - isRem) (t+1) newR
  where (isRem, newR) = let r' = (a - r) `rem` t in if r' == 0 then (0, 0) else (1, t - r')

main = do
  [n, m] <- scanArray
  a <- scanArray
  print $ firstTrue 1 (10^15) (canBeDone (0:a) m)


Polycarp must pay exactly $$$n$$$ burles at the checkout. He has coins of two nominal values: $$$1$$$ burle and $$$2$$$ burles. Polycarp likes both kinds of coins equally. So he doesn't want to pay with more coins of one type than with the other.Thus, Polycarp wants to minimize the difference between the count of coins of $$$1$$$ burle and $$$2$$$ burles being used. Help him by determining two non-negative integer values $$$c_1$$$ and $$$c_2$$$ which are the number of coins of $$$1$$$ burle and $$$2$$$ burles, respectively, so that the total value of that number of coins is exactly $$$n$$$ (i. e. $$$c_1 + 2 \cdot c_2 = n$$$), and the absolute value of the difference between $$$c_1$$$ and $$$c_2$$$ is as little as possible (i. e. you must minimize $$$|c_1-c_2|$$$).

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line. This line contains one integer $$$n$$$ ($$$1 \le n \le 10^9$$$) — the number of burles to be paid by Polycarp.

For each test case, output a separate line containing two integers $$$c_1$$$ and $$$c_2$$$ ($$$c_1, c_2 \ge 0$$$) separated by a space where $$$c_1$$$ is the number of coins of $$$1$$$ burle and $$$c_2$$$ is the number of coins of $$$2$$$ burles. If there are multiple optimal solutions, print any one.

NoteThe answer for the first test case is "334 333". The sum of the nominal values of all coins is $$$334 \cdot 1 + 333 \cdot 2 = 1000$$$, whereas $$$|334 - 333| = 1$$$. One can't get the better value because if $$$|c_1 - c_2| = 0$$$, then $$$c_1 = c_2$$$ and $$$c_1 \cdot 1 + c_1 \cdot 2 = 1000$$$, but then the value of $$$c_1$$$ isn't an integer.The answer for the second test case is "10 10". The sum of the nominal values is $$$10 \cdot 1 + 10 \cdot 2 = 30$$$ and $$$|10 - 10| = 0$$$, whereas there's no number having an absolute value less than $$$0$$$.

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

solution :: Int -> (Int, Int)
solution n = minimumBy (comparing $ \(n1, n2) -> abs (n1 - n2)) ns
  where
    d = n `div` 3
    ns = (\n2 -> (n - n2 * 2, n2)) <$> [d + i | i <- [-2 .. 2]]

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d\n") $ solution n

import Control.Monad
import Data.List

-- c1+2c2=n
-- c1=c2+1
-- c2+2c2+1 = n
-- c2*3+1=n

-- c2=c1+1
-- c1+2c1+2=n

-- c1=c1
-- c1+2c1=n

calc :: Int -> [Int]
calc n | n `mod` 3 == 0 =
         let c1 = n `div` 3
             c2 = c1 in [c1,c2]
calc n | n `mod` 3 == 1 =
         let c2 = (n-1) `div` 3
             c1 = c2+1 in [c1,c2]
calc n | n `mod` 3 == 2 =
         let c1 = (n-2) `div` 3
             c2 = c1+1 in [c1,c2]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    putStrLn $ intercalate " " $ map show $ calc n

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn :: IO [Integer]

    (putStr . unlines . map (showL . solve)) tcs

solve n | (m == 0) = [x, x]
        | (m == 1) = [x+1, x]
        | (m == 2) = [x, x+1]
        | otherwise = undefined
  where
    x = n `div` 3
    m = n `mod` 3

showL = intercalate " " . map show

solve :: [Int] -> [(Int, Int)]
solve [] = []
solve (x:xs) = (c1, c2) : solve xs
    where
        c2 = div (x + 1) 3
        c1 = x - c2 * 2

parseIn = tail . map (read :: String -> Int) . words

parseOut [] = ""
parseOut ((x, y):l) = show x ++ " " ++ show y ++"\n"++parseOut l

main :: IO ()
main = interact $ parseOut . solve . parseIn

module Main where
main = interact solve

solve :: String -> String
solve inp =
    let
        t = read . head . lines $ inp :: Int
        arr = (read <$>) . take t . tail . lines $ inp :: [Int]
        logic x =
            case x `mod` 3 of
                0 -> (x `div` 3, x `div` 3)
                2 -> (x `div` 3, x `div` 3 + 1)
                _ -> (x `div` 3 + 1, x `div` 3)
    in
        unlines . map ((\(a, b) -> show a ++ " " ++ show b) . logic) $ arr

import Control.Monad (replicateM_)

solve n = if d1 < d2
  then (c1, c2)
  else (c1 - 2, c2 + 1)
  where
    (d1, d2) = (n `rem` 3, 3 - n `rem` 3)
    (c1, c2) = (n `div` 3 + n `rem` 3, n `div` 3)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    (c1, c2) <- solve <$> readLn
    putStrLn $ show c1 ++ " " ++ show c2

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> map (read >>> solve >>> (\(x, y) -> show x ++ " " ++ show y))
      >>> unlines

solve :: Int -> (Int, Int)
solve n = let (q, r) = n `divMod` 3 in (q + bool 0 1 (r == 1), q + bool 0 1 (r == 2))

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  let cnt = div n 3
      (one, two) = case rem n 3 of 0 -> (cnt, cnt)
                                   1 -> (cnt+1, cnt)
                                   2 -> (cnt, cnt+1)
    in putStrLn $ show one ++ " " ++ show two

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

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs

import Control.Monad

solve :: Int -> (Int, Int)
solve n
  | a == 2    = (b, b + 1)
  | a == 1    = (b + 1, b)
  | otherwise = (b, b)
  where a = mod n 3
        b = div n 3

printSolve = do
  n <- readLn :: IO Int
  let p = solve n
  putStrLn (show (fst p) ++ " " ++ show (snd p))

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

import Control.Monad

solve n
        | mod n 3 == 2 = [r,r+1]
        | mod n 3 == 1 = [r+1,r]
        | otherwise = [r,r]
        where r = div n 3

printResult = do
    n <- readLn :: IO Integer
    putStrLn . unwords . map show $ solve n

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

module Main where

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

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

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

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    n <- readLn :: IO Int
    let d = n `div` 3
        r = n `mod` 3
    printList $ if r == 0 then [d, d] else if r == 1 then [d+1, d] else [d, d+1]

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

solution :: Int -> (Int, Int)
solution n = minimumBy (comparing $ \(n1, n2) -> abs (n1 - n2)) ns
  where
    d = n `div` 3
    ns = (\n2 -> (n - n2 * 2, n2)) <$> [d + i | i <- [-2 .. 2]]

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d") $ solution n

import Control.Monad
import Text.Printf

solution :: Int -> (Int, Int)
solution n = (n1, n2)
  where
    n1 = n `div` 3
    n2 = n - n1 * 2

main :: IO ()
main = do
  testCases <- read <$> getLine
  forM_ [1 .. testCases] $ \_ -> do
    n <- read <$> getLine
    uncurry (printf "%d %d") $ solution n

import Control.Monad
import Data.List

calc :: Int -> [Int]
calc n | n == 1 = [1,0]
calc n | n == 2 = [0,1]
calc n | n `mod` 2 == 0 =
         let [a,b] = calc (n `div` 2) in
           [2*a,2*b]
calc n | n `mod` 2 == 1 =
         let [a,b] = calc (n-1) in
           [a+1,b]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    putStrLn $ intercalate " " $ map show $ calc n


You are given a sequence of numbers a1, a2, ..., an, and a number m.Check if it is possible to choose a non-empty subsequence aij such that the sum of numbers in this subsequence is divisible by m.

The first line contains two numbers, n and m (1 ≤ n ≤ 106, 2 ≤ m ≤ 103) — the size of the original sequence and the number such that sum should be divisible by it. The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 109).

In the single line print either "YES" (without the quotes) if there exists the sought subsequence, or "NO" (without the quotes), if such subsequence doesn't exist.

NoteIn the first sample test you can choose numbers 2 and 3, the sum of which is divisible by 5.In the second sample test the single non-empty subsequence of numbers is a single number 5. Number 5 is not divisible by 6, that is, the sought subsequence doesn't exist.In the third sample test you need to choose two numbers 3 on the ends.In the fourth sample test you can take the whole subsequence.

import qualified Data.Set as S
main=interact $ solve. map read. words
solve (_:m:x)=  f S.empty x
        where f _ [] = "NO"
              f s (x:xs) = let members=S.toList s
                               s'=S.fromList members
                               s'' = S.insert (mod x m) $ foldl (\s k->S.insert  (mod (k+x)  m) s) s' members
                           in
                               if  S.member 0 s'' then "YES" else f s'' xs

import qualified Data.List as L
import qualified Data.Set as S

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

solve :: [Int] -> Bool
solve (n:m:a) = solve' a S.empty
    where
        solve' :: [Int] -> (S.Set Int) -> Bool
        solve' _      s | S.member 0 s = True
        solve' []     _ = False
        solve' (a:ax) s = let si = S.singleton (mod a m)
                              sn = S.map (\x -> mod (x + a) m) s
                              ssi = S.union s si
                              sin = S.union ssi sn
                          in  solve' ax sin

output :: Bool -> IO()
output True  = putStrLn "YES"
output False = putStrLn "NO"

import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
main :: IO()
main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap (map (unBox . C.readInt) . C.words) C.getLine :: IO [Int]
    if n>m
        then putStrLn "YES"
        else do
            let solved = solve m a S.empty
            if S.member 0 solved then putStrLn "YES" else putStrLn "NO"

solve :: Int -> [Int] -> S.Set Int -> S.Set Int
solve m [] ans = ans
solve m (a:as) ans =
    let mV = a `rem` m
        newS = S.insert mV $ S.union (ans) (S.map (\x -> rem (x+mV) m) ans)
    in solve m as newS

unBox (Just (a,b)) = a
unBox Nothing = 0

import Data.List
import qualified Data.ByteString.Char8 as SS
readInt bs = case SS.readInt bs of Just (i, _) -> i
readInts = map readInt . SS.words
parse = map readInts . SS.lines
solve [[n,m], a] = helper a []
    where helper [] _ = "NO"
          helper (a0:as) l
              | 0 `elem` l' = "YES"
              | otherwise = helper as l'
              where l' =  unique . sort . iter $ l
                    iter l = a0 `mod` m:l ++ map (\x -> (x + a0) `mod` m) l
          unique (a1:a2:as)
              | a1 == a2 = unique (a2:as)
              | otherwise = a1 : unique (a2:as)
          unique x = x
main = putStrLn . solve . parse =<< SS.getContents

import Data.List
import qualified Data.Set as S
main :: IO()
main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let solved = solve m a S.empty
    if S.member 0 solved then putStrLn "YES" else putStrLn "NO"

solve m [] ans = ans
solve m (a:as) ans =
    let mV = a `rem` m
        newS = S.union ans (S.map (\x -> rem (x+mV) m) ans)
    in solve m as newS

import Data.List
import qualified Data.ByteString.Char8 as SS
readInt bs = case SS.readInt bs of Just (i, _) -> i
readInts = map readInt . SS.words
parse = map readInts . SS.lines
solve [[n,m], a] = helper a []
    where helper [] _ = "NO"
          helper (a0:as) l
              | 0 `elem` l' = "YES"
              | otherwise = helper as l'
              where l' =  unique . sort . iter $ l
                    iter l = (a0:l) ++ (map (\x -> (x + a0) `mod` m) l)
          unique (a1:a2:as)
              | a1 == a2 = unique (a2:as)
              | otherwise = a1 : (unique (a2:as))
          unique x = x
main = putStrLn . solve . parse =<< SS.getContents


Berland scientists know that the Old Berland language had exactly n words. Those words had lengths of l1, l2, ..., ln letters. Every word consisted of two letters, 0 and 1. Ancient Berland people spoke quickly and didn’t make pauses between the words, but at the same time they could always understand each other perfectly. It was possible because no word was a prefix of another one. The prefix of a string is considered to be one of its substrings that starts from the initial symbol.Help the scientists determine whether all the words of the Old Berland language can be reconstructed and if they can, output the words themselves.

The first line contains one integer N (1 ≤ N ≤ 1000) — the number of words in Old Berland language. The second line contains N space-separated integers — the lengths of these words. All the lengths are natural numbers not exceeding 1000.

If there’s no such set of words, in the single line output NO. Otherwise, in the first line output YES, and in the next N lines output the words themselves in the order their lengths were given in the input file. If the answer is not unique, output any.

import List
main = interact f
f input = output where
  output = unlines ans
  [[num],len] = map (map (read::String->Int)) $ map words $ lines input
  len0 = sort $ zip len [1..]
  wrd [(x,y)] = [replicate x '1']
  wrd ((x,y):xs) = z:v where
    v = wrd xs
    z | head w == 'N' = "N"
      | x == fst(head xs)             = pre w
      | otherwise                     = pre $ take x w
       where
         w = head v
         pre xs | not (elem '1' xs) = "N"
                | last xs == '1'    = ys ++ "0"
                | otherwise         = (pre ys) ++ "1"
                 where ys = take (length xs - 1) xs
  ans0 = map snd $ sort $ zip (map snd len0) (wrd len0)
  ans = if head (head(wrd len0)) == 'N' then ["NO"] else "YES":ans0

import List
main = interact f
f input = output where
  output = unlines ans
  [[num],len] = map (map (read::String->Int)) $ map words $ lines input
  len0 = reverse $ sort $ zip len [1..]
  wrd [(x,y)] = [replicate x '0']
  wrd ((x,y):xs) = z:(wrd xs) where
    z | head (head $ wrd xs) == 'N' = "N"
      | x == fst(head xs)             = suc $ head $ wrd xs
      | otherwise                     = (suc $ head $ wrd xs)++"0"
       where
         suc xs | not (elem '0' xs) = "N"
                | last xs == '0'    = ys ++ "1"
                | otherwise         = (suc ys) ++ "0"
                 where ys = take (length xs - 1) xs
  ans0 = map snd $ sort $ zip (map snd len0) (wrd len0)
  ans = if head (head $ wrd len0) == 'N' then ["NO"] else "YES":ans0

import List
main = interact f
f input = output where
  output = unlines ans
  [[num],len] = map (map (read::String->Int)) $ map words $ lines input
  len0 = sort $ zip len [1..]
  wrd [(x,y)] = [replicate x '1']
  wrd ((x,y):xs) = z:(wrd xs) where
    z | head (head $ wrd xs) == 'N' = "N"
      | x == fst(head xs)             = pre $ head $ wrd xs
      | otherwise                     = pre $ take x $ head $ wrd xs
       where
         pre xs | not (elem '1' xs) = "N"
                | last xs == '1'    = ys ++ "0"
                | otherwise         = (pre ys) ++ "1"
                 where ys = take (length xs - 1) xs
  ans0 = map snd $ sort $ zip (map snd len0) (wrd len0)
  ans = if head (head ans0) == 'N' then ["NO"] else "YES":ans0

import List
main = interact f
f input = output where
  output = unlines ans
  [[num],len] = map (map (read::String->Int)) $ map words $ lines input
  len0 = sort $ zip len [1..]
  wrd [(x,y)] = [replicate x '1']
  wrd ((x,y):xs) = z:(wrd xs) where
    z | take 2 (head $ wrd xs) == "N" = "N"
      | x == fst(head xs)             = pre $ head $ wrd xs
      | otherwise                     = pre $ take x $ head $ wrd xs
       where
         pre xs | not (elem '1' xs) = "N"
                | last xs == '1'    = ys ++ "0"
                | otherwise         = (pre ys) ++ "1"
                 where ys = take (length xs - 1) xs
  ans0 = map snd $ sort $ zip (map snd len0) (wrd len0)
  ans = if head (head ans0) == 'N' then ["NO"] else "YES":ans0


A and B are preparing themselves for programming contests.B loves to debug his code. But before he runs the solution and starts debugging, he has to first compile the code.Initially, the compiler displayed n compilation errors, each of them is represented as a positive integer. After some effort, B managed to fix some mistake and then another one mistake.However, despite the fact that B is sure that he corrected the two errors, he can not understand exactly what compilation errors disappeared — the compiler of the language which B uses shows errors in the new order every time! B is sure that unlike many other programming languages, compilation errors for his programming language do not depend on each other, that is, if you correct one error, the set of other error does not change.Can you help B find out exactly what two errors he corrected?

The first line of the input contains integer n (3 ≤ n ≤ 105) — the initial number of compilation errors. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109) — the errors the compiler displayed for the first time.  The third line contains n - 1 space-separated integers b1, b2, ..., bn - 1 — the errors displayed at the second compilation. It is guaranteed that the sequence in the third line contains all numbers of the second string except for exactly one.  The fourth line contains n - 2 space-separated integers с1, с2, ..., сn - 2 — the errors displayed at the third compilation. It is guaranteed that the sequence in the fourth line contains all numbers of the third line except for exactly one.

Print two numbers on a single line: the numbers of the compilation errors that disappeared after B made the first and the second correction, respectively.

NoteIn the first test sample B first corrects the error number 8, then the error number 123.In the second test sample B first corrects the error number 1, then the error number 3. Note that if there are multiple errors with the same number, B can correct only one of them in one step.

import Data.List

parseList :: String -> [Integer]
parseList str = map read (words str)

getAnswer :: [Integer] -> [Integer] -> [Integer] -> (Integer, Integer)
getAnswer first second third = (findRemoved f s, findRemoved s t)
    where f = sort first
          s = sort second
          t = sort third

findRemoved :: [Integer] -> [Integer] -> Integer
findRemoved [x] [] = x
findRemoved [] [y] = y
findRemoved [] [] = 0
findRemoved (x:xs) (y:ys) = if x == y
                            then findRemoved xs ys
                            else x

main :: IO ()
main = do
    n <- getLine
    first <- getLine
    second <- getLine
    third <- getLine
    let (a, b) = getAnswer (parseList first) (parseList second) (parseList third)
    putStrLn $ show a
    putStrLn $ show b

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

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

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

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

main = do
	getLine
	[ a, b, c ] <- map sort <$> replicateM 3 getInts
	print $ f a b
	print $ f b c

f (a:as) [] = a
f (a:as) (b:bs)
	| a == b = f as bs
	| otherwise = a

module Main (main)
    where

import Control.Monad (replicateM)

readInts :: String -> [Int]
readInts = map read . words

main :: IO ()
main = putStr . toStr . solve . map readInts =<< (getLine >> replicateM 3 getLine)
    where solve [as,bs,cs] = let (x,y) = (sum as, sum bs)
                              in [x - y, y - sum cs]
          toStr = unlines . map show

-- https://wiki.haskell.org/Performance
-- http://hackage.haskell.org/package/vector
-- https://wiki.haskell.org/Unboxed_type
-- http://hackage.haskell.org/package/vector-0.12.0.1/docs/Data-Vector-Generic.html

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

main = do
  ff <- getLine
  gg <- getLine
  hh <- getLine
  dd <- getLine

  let aa = conv (words gg) []
      bb = conv (words hh) []
      cc = conv (words dd) []

  putStrLn (show (sum aa - sum bb))
  putStrLn (show (sum bb - sum cc))

import Data.List

ans :: [Int] -> [Int] -> Int
ans a b = f (sort a) (sort b) where
	f [x] _ = x
	f (x:xs) (p:ps)
		| x /= p = x
		| otherwise = f xs ps

main :: IO()
main = do
	n <- getLine
	s1 <- fmap (map read . words) getLine
	s2 <- fmap (map read . words) getLine
	s3 <- fmap (map read . words) getLine
	putStrLn $ (show $ ans s1 s2)
	putStrLn $ (show $ ans s2 s3)

-- http://codeforces.com/problemset/problem/519/B

import Data.List
import Data.Char
getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

main = do
	lns <- getLines 4

	let
		n = read $ lns !! 0 :: Int
		e1 = map read $ words $ lns !! 1 :: [Int]
		e2 = map read $ words $ lns !! 2 :: [Int]
		e3 = map read $ words $ lns !! 3 :: [Int]

	putStrLn $ show $ findRemainder e1 e2
	putStrLn $ show $ findRemainder e2 e3

-- If both list of errors are constructed purely from
-- integers the fixed errors is the remainder of the
-- difference betweeen the non-fixed list and fixed list
findRemainder :: [Int] -> [Int] -> Int
findRemainder (x:[]) [] = x
findRemainder (x:xs) (y:ys) = x - y + (findRemainder xs ys)

main = do
  getLine
  a <- fmap (sum . map read . words) getLine
  b <- fmap (sum . map read . words) getLine
  c <- fmap (sum . map read . words) getLine

  print $ a - b
  print $ b - c

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \n -> (mapM_ putStrLn).solve =<< (forM [1..3] $ \i ->  getLine>>= \j -> return $ words j)
solve::[[String]]->[String]
solve [x,y,z] = let sx = sort x; sy= sort y; sz= sort z in [slv1 sx sy, slv1 sy sz]
slv1 (x:xs) [] = x
slv1 (x:xs) (y:ys) = if x/=y then x else slv1 xs ys

-- Codeforces 519B

import Control.Monad

main :: IO ()
main = do
    n <- fmap read getLine :: IO Integer
    fmap (map read . words) getLine >>= solve 2

solve :: Integer -> [Integer] -> IO ()
solve 0 _ = return ()
solve n xs = do
    nxt <- fmap (map read . words) getLine
    print ((sum xs) - (sum nxt))
    solve (n-1) nxt

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

f a b = if a==b then Nothing else Just (a-b)

main=do
    n<-     read  <$> getLine::IO Integer
    [q1,q2,q3]<-  map (map (fst.fromJust.C.readInteger) ) <$> map (C.words) <$> C.lines <$> C.getContents::IO [[Integer]]
    let [m1,m2,m3] = map (\z-> M.fromListWith (+) $ zip z (repeat 1)) [q1,q2,q3]
    print  $ fst $ head $ M.toList $ M.differenceWith f m1 m2
    print  $ fst $ head $ M.toList $ M.differenceWith f m2 m3

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

solve :: [[Integer]] -> [Integer]
solve [ as, bs, cs ] = [ sum as - sum bs, sum bs - sum cs ]
solve _ = undefined

main=getContents>>=mapM_ print.f.map(map read.words).tail.lines
f[a,b,c]=[sum a-sum b,sum b-sum c]

main = interact $ unlines . map show . solve . parse
parse = map (sum . map read . words) . tail . lines
solve ns = zipWith (-) ns (tail ns) where

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

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
main = do
  B.getLine
  a <- readInts
  b <- readInts
  c <- readInts
  let [x,y,z] = map sum [a,b,c]
  putStrLn . unlines . map show $ [x-y,y-z]

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

readInts = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
main = do
  B.getLine
  a <- readInts
  b <- readInts
  c <- readInts
  let [x,y,z] = map sum [a,b,c]
  print $ x - y
  print $ y - z

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  ys <- map readInt.B.words <$> B.getLine
  zs <- map readInt.B.words <$> B.getLine
  putStr.unlines.map show $ solve (sort xs) (sort ys) (sort zs)

solve :: [Int] -> [Int] -> [Int] -> [Int]
solve xs ys zs = [go xs ys, go ys zs]
   where
     go (x:xs) (y:ys)
       | x == y = go xs ys
       | otherwise = x
     go [x] [] = x

import Control.Applicative

main = do
	_ <- getLine
	set1 <- sum . map read . words <$> getLine
	set2 <- sum . map read . words <$> getLine
	set3 <- sum . map read . words <$> getLine
	print $ set1 - set2
	print $ set2 - set3

import qualified Data.Set as S
import qualified Data.Map.Strict as M

import Data.List (foldl')
import Control.Monad (replicateM)

main :: IO ()
main = do
  _ <- getLine
  (b0:b1:b2:_) <- replicateM 3 (S.fromAscList . M.toAscList . buildDict . words <$> getLine)
  putStrLn $ fst . head $ S.toList (S.difference b0 b1)
  putStrLn $ fst . head $ S.toList (S.difference b1 b2)

  where
    buildDict = foldl' (\m s -> M.insertWith (\_ o -> o + 1) s 1 m) M.empty

import qualified Data.Set as S
import qualified Data.Map.Strict as M

import Data.List (foldl')
import Control.Monad (replicateM)

main :: IO ()
main = do
  _ <- getLine
  (b0:b1:b2:_) <- replicateM 3 (S.fromAscList . M.toAscList . buildDict . words <$> getLine)
  putStrLn $ fst . head $ S.toList (S.difference b0 b1)
  putStrLn $ fst . head $ S.toList (S.difference b1 b2)

  where
    buildDict = foldr (\s m -> M.insertWith (\_ o -> o + 1) s 1 m) M.empty

import Control.Applicative
import Data.List

solve :: [Int] -> [Int] -> Int
solve as bs = case filter (uncurry (/=)) $ zip as' bs' of
                (a, _):_  -> a
                otherwise -> last as'
              where
                as' = sort as
                bs' = sort bs

main :: IO ()
main = do
  _ <- getLine
  as <- map read <$> words <$> getLine
  bs <- map read <$> words <$> getLine
  cs <- map read <$> words <$> getLine
  print $ solve as bs
  print $ solve bs cs

module Main (main) where

import Control.Monad
import Data.Functor

isDigit x = x>='0' && x<='9'
split f l@(a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Integer]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs

main = do
	_ <- getLine
	a <- (sum.readInts) <$> getLine
	b <- (sum.readInts) <$> getLine
	c <- (sum.readInts) <$> getLine
	print $ a-b
	print $ b-c

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

main=do
	getLine
	a<-  sort.map (fst.fromJust.C.readInt).C.words  <$> C.getLine::IO [Int]
	b<-  sort.map (fst.fromJust.C.readInt).C.words  <$> C.getLine::IO [Int]
	c<-  sort.map (fst.fromJust.C.readInt).C.words  <$> C.getLine::IO [Int]
	print $ fst $ head $ filter (\z-> fst z /= snd z) $ zip a (b++[0])
        print $ fst $ head $ filter (\z-> fst z /= snd z) $ zip b (c++[0])

import Control.Monad

getSumOfLine = do
  line <- getLine
  return(sum([read n :: Int | n <- words line]))

main = do
  getLine
  [a,b,c] <- replicateM 3 getSumOfLine
  print(a-b)
  print(b-c)

main = do
  getLine
  m <- sequence $ replicate 3 getLine
  let mf = map (map read . words) m
  let [mf1, mf2, mf3] = map sum mf
  print $ mf1 - mf2
  print $ mf2 - mf3

import Data.List
solve :: [Int] -> [Int] -> Int
solve [a] [] = a
solve (a:as) (b:bs)
  | a /= b    = a
  | otherwise = solve as bs
main = do
  getLine
  [as, bs, cs] <- getContents >>= return. map (Data.List.sort. map read. words). lines
  print $ solve as bs
  print $ solve bs cs

import Control.Applicative ((<$>))
import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of
                  Just (n,_) -> n
                  _-> error $ "readInt error : bs = " ++ show bs

solve (x:_) [] = x
solve [] (y:_) = y
solve [] [] = 0
solve (x:xs) (y:ys)
    | x /= y = x
    | otherwise = solve xs ys

main :: IO ()
main = do
    _ <- getLine
    lst0 <- map readInt . B.words <$> B.getLine
    lst1 <- map readInt . B.words <$> B.getLine
    lst2 <- map readInt . B.words <$> B.getLine
    let [a, b, c] = map sum [lst0, lst1, lst2]
    print $ a - b
    print $ b - c

import Control.Applicative ((<$>))
import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of
                  Just (n,_) -> n
                  _-> error $ "readInt error : bs = " ++ show bs

solve (x:_) [] = x
solve [] (y:_) = y
solve [] [] = 0
solve (x:xs) (y:ys)
    | x /= y = x
    | otherwise = solve xs ys

main :: IO ()
main = do
    _ <- getLine
    lst0 <- map readInt . B.words <$> B.getLine
    lst1 <- map readInt . B.words <$> B.getLine
    lst2 <- map readInt . B.words <$> B.getLine
    let a = sort lst0
        b = sort lst1
        c = sort lst2
    let (e1, e2) = (solve a b, solve b c)
    print e1
    print e2

import Control.Applicative ((<$>))
import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of
                  Just (n,_) -> n
                  _-> error $ "readInt error : bs = " ++ show bs

main :: IO ()
main = do
    _ <- getLine
    lst0 <- map readInt . B.words <$> B.getLine
    lst1 <- map readInt . B.words <$> B.getLine
    lst2 <- map readInt . B.words <$> B.getLine
    let [a, b, c] = map sum [lst0, lst1, lst2]
    print $ a - b
    print $ b - c

import Data.List

solve :: (Num a, Eq a) => [a] -> [a] -> a
solve (x:_) [] = x
solve [] (y:_) = y
solve [] [] = 0
solve (x:xs) (y:ys)
    | x /= y = x
    | otherwise = solve xs ys

main :: IO ()
main = do
    _ <- getLine
    lst0 <- getLine >>= return . map (\c -> read c::Integer) . words
    lst1 <- getLine >>= return . map (\c -> read c::Integer) . words
    lst2 <- getLine >>= return . map (\c -> read c::Integer) . words
    let a = sort lst0
        b = sort lst1
        c = sort lst2
    let (e1, e2) = (solve a b, solve b c)
    print e1
    print e2

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

main :: IO ()
main = do
  n <- getLine
  xs <- inLine
  ys <- inLine
  zs <- inLine
  let a = sum xs
      b = sum ys
      c = sum zs
  print $ a - b
  print $ b - c

import Data.List (sort)

process :: [Int] -> [Int] -> [Int] -> (Int,Int)
process xs ys zs = (f xs' ys', f ys' zs')
    where
        xs' = sort xs
        ys' = sort ys
        zs' = sort zs
        f [a] [] = a
        f (a:as) (b:bs)
            | a == b = f as bs
            | otherwise = a

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    bs <- fmap (map readInt.words) getLine
    cs <- fmap (map readInt.words) getLine
    let (t1,t2) = process as bs cs
    print t1
    print t2

module Main where

import Control.Monad

import Data.Set (Set)
import qualified Data.Set as S

import Data.List (sort)

main = do
  c <- getContents
  let (_:l1:l2:l3:_) = lines c
  let e1 = sort . map (read :: String -> Int) . words $ l1
  let e2 = sort . map (read :: String -> Int) . words $ l2
  let e3 = sort . map (read :: String -> Int) . words $ l3
  print $ firstDifferance e1 e2
  print $ firstDifferance e2 e3

{-
  let s1 = S.fromList e1
  let s2 = S.fromList e2
  let s3 = S.fromList e3
  let disappeared = s1 S.\\ s3
  let r1 = disappeared S.\\ s2
  let r2 = disappeared S.\\ r1
  print r1
  print r2
-}

firstDifferance :: [Int] -> [Int] -> Int
firstDifferance [] [] = undefined
firstDifferance (x:_) [] = x
firstDifferance (x:xs) (y:ys)
  | x == y    = firstDifferance xs ys
  | otherwise = x

import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.Int
-- meat

solve :: [[Int64]] -> [[Int64]]
solve [[_], as, bs, cs] = [[sas - sbs], [sbs - scs]]
    where [sas, sbs,scs] = fmap sum [as,bs,cs]
solve _ = error "you're fucked"

-- shit
main :: IO ()
main = BS.interact $ outputIntMatrixBS . solve . inputNumMatrixBS

inputNumMatrixBS :: (Num a) => BS.ByteString ->[[a]]
inputNumMatrixBS = parseMatrixBS . matrifyBS

outputIntMatrixBS :: (Integral a) => [[a]] -> BS.ByteString
outputIntMatrixBS = unmatrifyBS . unparseMatrixBs

matrifyBS :: BS.ByteString -> [[BS.ByteString]]
matrifyBS = fmap BS.words . BS.lines

parseMatrixBS :: (Num a) => [[BS.ByteString]] ->[[a]]
parseMatrixBS = fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger

unparseMatrixBs :: (Integral a) => [[a]] -> [[BS.ByteString]]
unparseMatrixBs = fmap.fmap $ (toLazyByteString . integerDec . toInteger)

unmatrifyBS :: [[BS.ByteString]] -> BS.ByteString
unmatrifyBS = BS.unlines . fmap BS.unwords

import Control.Applicative
main = do
  getLine
  m <- sequence $ replicate 3 getLine
  let mf = map (map read . words) m
  let [mf1, mf2, mf3] = map msort mf
  print $ gone2 mf1 mf2
  print $ gone2 mf2 mf3
qsort :: Ord a => [a] -> [a]
qsort [] = []
qsort [x] = [x]
qsort (x:xs) = (qsort $ filter (<x) xs) ++ [x] ++ (qsort $ filter (>= x) xs)
msort :: Ord a => [a] -> [a]
msort [] = []
msort [x] = [x]
msort x = (msort $ take (quot len 2) x) ++ (msort $ drop (quot len 2) x)
  where len = length x
th :: Int -> [a] -> a
th 1 a = head a
th n a = th (n-1) (tail a)
gone :: [Int] -> [Int] -> Int
gone x y = th len x
  where len = ((length . takeWhile (==True) . getZipList) $ (==) <$> (ZipList x) <*> (ZipList y)) + 1
gone2 :: [Int] -> [Int] -> Int
gone2 x y = (head . dropWhile (==0) . getZipList) $ (\u v -> if (u==v) then 0 else u) <$> (ZipList x) <*> (ZipList (y++[0]))


Vasya lagged behind at the University and got to the battlefield. Just joking! He's simply playing some computer game. The field is a flat platform with n trenches dug on it. The trenches are segments on a plane parallel to the coordinate axes. No two trenches intersect.There is a huge enemy laser far away from Vasya. The laser charges for a seconds, and then shoots continuously for b seconds. Then, it charges for a seconds again. Then it shoots continuously for b seconds again and so on. Vasya knows numbers a and b. He also knows that while the laser is shooting, Vasya must be in the trench, but while the laser is charging, Vasya can safely move around the field. The main thing is to have time to hide in the trench before the shot. If Vasya reaches the trench exactly at the moment when the laser starts shooting, we believe that Vasya managed to hide. Coincidentally, the length of any trench in meters numerically does not exceed b.Initially, Vasya is at point A. He needs to get to point B. Vasya moves at speed 1 meter per second in either direction. You can get in or out of the trench at any its point. Getting in or out of the trench takes no time. It is also possible to move in the trench, without leaving it.What is the minimum time Vasya needs to get from point A to point B, if at the initial time the laser has just started charging? If Vasya cannot get from point A to point B, print -1. If Vasya reaches point B at the moment when the laser begins to shoot, it is believed that Vasya managed to reach point B.

The first line contains two space-separated integers: a and b (1 ≤ a, b ≤ 1000), — the duration of charging and the duration of shooting, in seconds. The second line contains four space-separated integers: Ax, Ay, Bx, By ( - 104 ≤ Ax, Ay, Bx, By ≤ 104) — the coordinates of points А and B. It is guaranteed that points A and B do not belong to any trench. The third line contains a single integer: n (1 ≤ n ≤ 1000), — the number of trenches.  Each of the following n lines contains four space-separated integers: x1, y1, x2, y2 ( - 104 ≤ xi, yi ≤ 104) — the coordinates of ends of the corresponding trench. All coordinates are given in meters. It is guaranteed that for any trench either x1 = x2, or y1 = y2. No two trenches intersect. The length of any trench in meters doesn't exceed b numerically.

If Vasya can get from point A to point B, print the minimum time he will need for it. Otherwise, print number -1. The answer will be considered correct if the absolute or relative error does not exceed 10 - 4

{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.Array
import Data.Array.IO
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as U
import qualified Data.Array.MArray as M
import Text.Printf

type Trench = (Int,Int,Int,Int)

dist :: Int -> Int -> Double
dist dx dy = sqrt ss
  where ss = fromIntegral (dx*dx+dy*dy)

comp x a b
  | x < a = LT
  | x > b = GT
  | otherwise = EQ

parallelDist w a b c d
  | b < c     = dist w (b-c)
  | d < a     = dist w (a-d)
  | otherwise = dist w 0

crossDist x y1 y2 u1 u2 v =
  case comp v y1 y2 of
    LT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y1-v)
            GT -> dist (x-u2) (y1-v)
            EQ -> dist 0      (y1-v)
    GT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y2-v)
            GT -> dist (x-u2) (y2-v)
            EQ -> dist 0      (y2-v)
    EQ -> case comp x u1 u2 of
            LT -> dist (x-u1) 0
            GT -> dist (x-u2) 0
            EQ -> dist 0 0

tdist (x1,y1,x2,y2) (u1,v1,u2,v2)
  | x1 == x2 && u1 == u2 = parallelDist (x1-u1) y1 y2 v1 v2
  | x1 == x2 && v1 == v2 = crossDist x1 y1 y2 u1 u2 v1
  | y1 == y2 && v1 == v2 = parallelDist (y1-v1) x1 x2 u1 u2
  | y1 == y2 && u1 == u2 = crossDist y1 x1 x2 v1 v2 u1

ptdist :: (Int,Int) -> Trench -> Double
ptdist (x,y) t = tdist (x,y,x,y) t

pdist (x,y) (u,v) = dist (x-u) (y-v)

compute :: Double -> Double -> (Int,Int) -> (Int,Int) -> [Trench] -> IO [Double]
compute a b start end trenchList = do
  let n = length trenchList
      trenches = listArray (1,n) trenchList
  dist <- newArray (1,n) (10*n) :: IO (IOUArray Int Int)

  let reachable i = [ j | j <- [1..n], j /= i, tdist t1 (trenches!j) <= a ]
        where t1 = trenches!i

  -- ts0 = list of trenches reachable from (x,y) in one hop
  let ts0 = filter (\i -> ptdist start (trenches!i) <= a) [1..n]
  let loop _ [] = return()
      loop d ts = do ts' <- go [] ts; loop (d+1) (concatMap reachable ts')
        where go ts' [] = return ts'
              go ts' (i:is) = do changed <- update i d
                                 if changed then go (i:ts') is
                                            else go ts' is
              update i d = do v <- readArray dist i
                              if v > d then do writeArray dist i d; return True
                                       else return False
  loop 1 ts0
  dist' <- M.freeze dist :: IO (UArray Int Int)
  let sols = [ d | i <- [1..n], let hops = dist' U.! i,
                        hops <= n,
                        let d1 = ptdist end (trenches!i),
                        d1 <= a,
                        let d = (fromIntegral hops*(a+b)) + d1 ]
{-
  putStr "dist: "
  forM_ [1..n] $ \i -> do v <- readArray dist i; putStr $ show v ++ " "
  putStrLn ""
  print sols
-}
  return sols

solve a b s@(sx,sy) e@(ex,ey) ts = do
  let d0 = dist (sx-ex) (sy-ey)
  if d0 <= a
    then return d0
    else do sols <- compute a b s e ts
            if null sols then return (-1)
                         else return $ minimum sols

normalize x1 y1 x2 y2
  | x1 == x2 = if y1 < y2 then (x1,y1,x2,y2) else (x2,y2,x1,y1)
  | y1 == y2 = if x1 < x2 then (x1,y1,x2,y2) else (x2,y2,x1,y1)

main = do
  (a:b:_) <- fmap (map read . words) getLine
  (sx:sy:ex:ey:_) <- fmap (map read . words) getLine
  n <- fmap read getLine
  trenches <- replicateM n $ do (x1:y1:x2:y2:_) <- fmap (map read . words) getLine
                                return $ normalize x1 y1 x2 y2
  answer <- solve a b (sx,sy) (ex,ey) trenches
  if answer < 0
    then putStrLn "-1"
    else putStrLn $ printf "%.6f" answer

{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.Array
import Data.Array.IO
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as U
import qualified Data.Array.MArray as M
import Text.Printf

type Trench = (Int,Int,Int,Int)

dist :: Int -> Int -> Double
dist dx dy = sqrt ss
  where ss = fromIntegral (dx*dx+dy*dy)

comp x a b
  | x < a = LT
  | x > b = GT
  | otherwise = EQ

parallelDist w a b c d
  | b < c     = dist w (b-c)
  | d < a     = dist w (a-d)
  | otherwise = dist w 0

crossDist x y1 y2 u1 u2 v =
  case comp v y1 y2 of
    LT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y1-v)
            GT -> dist (x-u2) (y1-v)
            EQ -> dist 0      (y1-v)
    GT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y2-v)
            GT -> dist (x-u2) (y2-v)
            EQ -> dist 0      (y2-v)
    EQ -> case comp x u1 u2 of
            LT -> dist (x-u1) 0
            GT -> dist (x-u2) 0
            EQ -> dist 0 0

tdist (x1,y1,x2,y2) (u1,v1,u2,v2)
  | x1 == x2 && u1 == u2 = parallelDist (x1-u1) y1 y2 v1 v2
  | x1 == x2 && v1 == v2 = crossDist x1 y1 y2 u1 u2 v1
  | y1 == y2 && v1 == v2 = parallelDist (y1-v1) x1 x2 u1 u2
  | y1 == y2 && u1 == u2 = crossDist y1 x1 x2 v1 v2 u1

ptdist :: (Int,Int) -> Trench -> Double
ptdist (x,y) t = tdist (x,y,x,y) t

pdist (x,y) (u,v) = dist (x-u) (y-v)

compute :: Double -> Double -> (Int,Int) -> (Int,Int) -> [Trench] -> IO [Double]
compute a b start end trenchList = do
  let n = length trenchList
      trenches = listArray (1,n) trenchList
  dist <- newArray (1,n) (100*n) :: IO (IOUArray Int Int)

  let reachable i = [ j | j <- [1..n], j /= i, tdist t1 (trenches!j) <= a ]
        where t1 = trenches!i

  -- ts0 = list of trenches reachable from (x,y) in one hop
  let ts0 = filter (\i -> ptdist start (trenches!i) <= a) [1..n]
  let loop _ [] = return()
      loop d ts = do ts' <- go [] ts; loop (d+1) (concatMap reachable ts')
        where go ts' [] = return ts'
              go ts' (i:is) = do changed <- update i d
                                 if changed then go (i:ts') is
                                            else go ts' is
              update i d = do v <- readArray dist i
                              if v > d then do writeArray dist i d; return True
                                       else return False
  loop 1 ts0
  dist' <- M.freeze dist :: IO (UArray Int Int)
  let sols = [ d | i <- [1..n], let hops = dist' U.! i,
                        hops <= n,
                        let d1 = ptdist end (trenches!i),
                        d1 <= a,
                        let d = (fromIntegral hops*(a+b)) + d1 ]
{-
  putStr "dist: "
  forM_ [1..n] $ \i -> do v <- readArray dist i; putStr $ show v ++ " "
  putStrLn ""
  print sols
-}
  return sols

solve a b s@(sx,sy) e@(ex,ey) ts = do
  let d0 = dist (sx-ex) (sy-ey)
  if d0 <= a
    then return d0
    else do sols <- compute a b s e ts
            if null sols then return (-1)
                         else return $ minimum sols

main = do
  (a:b:_) <- fmap (map read . words) getLine
  (sx:sy:ex:ey:_) <- fmap (map read . words) getLine
  n <- fmap read getLine
  trenches <- replicateM n $ do (x1:y1:x2:y2:_) <- fmap (map read . words) getLine; return (x1,y1,x2,y2)
  answer <- solve a b (sx,sy) (ex,ey) trenches
  if answer < 0
    then putStrLn "-1"
    else putStrLn $ printf "%.6f" answer

{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.Array
import Data.Array.IO
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as U
import qualified Data.Array.MArray as M
import Text.Printf

type Trench = (Int,Int,Int,Int)

dist :: Int -> Int -> Double
dist dx dy = sqrt ss
  where ss = fromIntegral (dx*dx+dy*dy)

comp x a b
  | x < a = LT
  | x > b = GT
  | otherwise = EQ

parallelDist w a b c d
  | b < c     = dist w (b-c)
  | d < a     = dist w (a-d)
  | otherwise = dist w 0

crossDist x y1 y2 u1 u2 v =
  case comp v y1 y2 of
    LT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y1-v)
            GT -> dist (x-u2) (y1-v)
            EQ -> dist 0      (y1-v)
    GT -> case comp x u1 u2 of
            LT -> dist (x-u1) (y2-v)
            GT -> dist (x-u2) (y2-v)
            EQ -> dist 0      (y2-v)
    EQ -> case comp x u1 u2 of
            LT -> dist (x-u1) 0
            GT -> dist (x-u2) 0
            EQ -> dist 0 0

tdist (x1,y1,x2,y2) (u1,v1,u2,v2)
  | x1 == x2 && u1 == u2 = parallelDist (x1-u1) y1 y2 v1 v2
  | x1 == x2 && v1 == v2 = crossDist x1 y1 y2 u1 u2 v1
  | y1 == y2 && v1 == v2 = parallelDist (y1-v1) x1 x2 u1 u2
  | y1 == y2 && u1 == u2 = crossDist y1 x1 x2 v1 v2 u1

ptdist :: (Int,Int) -> Trench -> Double
ptdist (x,y) t = tdist (x,y,x,y) t

pdist (x,y) (u,v) = dist (x-u) (y-v)

compute :: Double -> Double -> (Int,Int) -> (Int,Int) -> [Trench] -> IO (([Double], IOUArray Int Int))
compute a b start end trenchList = do
  let n = length trenchList
      trenches = listArray (1,n) trenchList
  dist <- newArray (1,n) (100*n) :: IO (IOUArray Int Int)

  let reachable i = [ j | j <- [1..n], j /= i, tdist t1 (trenches!j) <= a ]
        where t1 = trenches!i

  -- ts0 = list of trenches reachable from (x,y) in one hop
  let ts0 = filter (\i -> ptdist start (trenches!i) <= a) [1..n]
  let loop _ [] = return()
      loop d ts = do ts' <- go [] ts; loop (d+1) (concatMap reachable ts')
        where go ts' [] = return ts'
              go ts' (i:is) = do changed <- update i d
                                 if changed then go (i:ts') is
                                            else go ts' is
              update i d = do v <- readArray dist i
                              if v > d then do writeArray dist i d; return True
                                       else return False
  loop 1 ts0
  dist' <- M.freeze dist :: IO (UArray Int Int)
  let solutions = [ d | i <- [1..n], let hops = dist' U.! i,
                        hops <= n,
                        let d1 = ptdist end (trenches!i),
                        d1 <= a,
                        let d = (fromIntegral hops*(a+b)) + d1 ]
  return (solutions, dist)

test a b start end ts = do
  (sols,dist) <- compute a b start end ts
  (lo,hi) <- getBounds dist
  putStr "dist: "
  forM_ [lo..hi] $ \i -> do v <- readArray dist i; putStr $ show v ++ " "
  putStrLn ""
  print sols

test1 = test 2 4 (0,5) (6,5) [ (0,0,0,4), (1,1,4,1), (6,0,6,4) ]

main = do
  (a:b:_) <- fmap (map read . words) getLine
  (sx:sy:ex:ey:_) <- fmap (map read . words) getLine
  n <- fmap read getLine
  trenches <- replicateM n $ do (x1:y1:x2:y2:_) <- fmap (map read . words) getLine; return (x1,y1,x2,y2)
  (sols,_) <- compute a b (sx,sy) (ex,ey) trenches
  let answer = if null sols then -1 else minimum sols
  if null sols
    then putStrLn "-1"
    else putStrLn $ printf "%.6f" answer


Iahub helps his grandfather at the farm. Today he must milk the cows. There are n cows sitting in a row, numbered from 1 to n from left to right. Each cow is either facing to the left or facing to the right. When Iahub milks a cow, all the cows that see the current cow get scared and lose one unit of the quantity of milk that they can give. A cow facing left sees all the cows with lower indices than her index, and a cow facing right sees all the cows with higher indices than her index. A cow that got scared once can get scared again (and lose one more unit of milk). A cow that has been milked once cannot get scared and lose any more milk. You can assume that a cow never loses all the milk she can give (a cow gives an infinitely amount of milk).Iahub can decide the order in which he milks the cows. But he must milk each cow exactly once. Iahub wants to lose as little milk as possible. Print the minimum amount of milk that is lost.

The first line contains an integer n (1 ≤ n ≤ 200000). The second line contains n integers a1, a2, ..., an, where ai is 0 if the cow number i is facing left, and 1 if it is facing right.

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

NoteIn the first sample Iahub milks the cows in the following order: cow 3, cow 4, cow 2, cow 1. When he milks cow 3, cow 4 loses 1 unit of milk. After that, no more milk is lost.

main = getContents >>= print . f . map read . tail . words
f x = sum . zipWith (*) x . scanr1 (+) $ map (1 -) x

main = getContents >>= print . fst . foldl f (0, 0) . map read . tail . words
f (a, b) c
  | c == 0 = (a + b, b)
  | c == 1 = (a, b + 1)