After the fourth season Sherlock and Moriary have realized the whole foolishness of the battle between them and decided to continue their competitions in peaceful game of Credit Cards.Rules of this game are simple: each player bring his favourite n-digit credit card. Then both players name the digits written on their cards one by one. If two digits are not equal, then the player, whose digit is smaller gets a flick (knock in the forehead usually made with a forefinger) from the other player. For example, if n = 3, Sherlock's card is 123 and Moriarty's card has number 321, first Sherlock names 1 and Moriarty names 3 so Sherlock gets a flick. Then they both digit 2 so no one gets a flick. Finally, Sherlock names 3, while Moriarty names 1 and gets a flick.Of course, Sherlock will play honestly naming digits one by one in the order they are given, while Moriary, as a true villain, plans to cheat. He is going to name his digits in some other order (however, he is not going to change the overall number of occurences of each digit). For example, in case above Moriarty could name 1, 2, 3 and get no flicks at all, or he can name 2, 3 and 1 to give Sherlock two flicks.Your goal is to find out the minimum possible number of flicks Moriarty will get (no one likes flicks) and the maximum possible number of flicks Sherlock can get from Moriarty. Note, that these two goals are different and the optimal result may be obtained by using different strategies.

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the number of digits in the cards Sherlock and Moriarty are going to use. The second line contains n digits — Sherlock's credit card number. The third line contains n digits — Moriarty's credit card number.

First print the minimum possible number of flicks Moriarty will get. Then print the maximum possible number of flicks that Sherlock can get from Moriarty.

NoteFirst sample is elaborated in the problem statement. In the second sample, there is no way Moriarty can avoid getting two flicks.

module Main where

import Data.List
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

solve s m =
  [ fst $ foldl' (\(c, mc1) sh -> maybe (c + 1, mc1) (\h -> (c, mc1//[(h, mc1!h - 1)])) $ find (\h -> mc1!h > 0) [sh..'9']) (0, mc) s
  , fst $ foldl' (\(c, mc1) sh -> maybe (c, mc1) (\h -> (c + 1, mc1//[(h, mc1!h - 1)])) $ find (\h -> mc1!h > 0) [(succ sh)..'9']) (0, mc) s
  ]
  where
    cnt xs = accumArray (+) 0 ('0', '9') (zip xs (repeat 1))
    -- rnk = array ('0', '9') . tail . scanl' (\(c', n') (c, n) -> (c, n' + n)) ('0', 0) . assocs . cnt
    -- sr = rnk s
    sc = cnt s
    -- mr = rnk m
    mc = cnt m

main = do
  _ <- readInt <$> B.getLine
  s <- getLine
  m <- getLine
  mapM_ (putStrLn . show) $ solve s m

module Main where

import Data.List
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

solve s m =
  [ fst $ foldl' (\(c, mc1) sh -> maybe (c + 1, mc1) (\h -> (c, mc1//[(h, mc1!h - 1)])) $ find (\h -> mc1!h > 0) [sh..'9']) (0, mc) s
  , fst $ foldl' (\(c, mc1) sh -> maybe (c, mc1) (\h -> (c + 1, mc1//[(h, mc1!h - 1)])) $ find (\h -> mc1!h > 0) [(succ sh)..'9']) (0, mc) s
  ]
  where
    cnt xs = accumArray (+) 0 ('0', '9') (zip xs (repeat 1))
    -- rnk = array ('0', '9') . tail . scanl' (\(c', n') (c, n) -> (c, n' + n)) ('0', 0) . assocs . cnt
    -- sr = rnk s
    sc = cnt s
    -- mr = rnk m
    mc = cnt m

main = do
  _ <- readInt <$> B.getLine
  s <- getLine
  m <- getLine
  print $ solve s m


It's a very unfortunate day for Volodya today. He got bad mark in algebra and was therefore forced to do some work in the kitchen, namely to cook borscht (traditional Russian soup). This should also improve his algebra skills.According to the borscht recipe it consists of n ingredients that have to be mixed in proportion  litres (thus, there should be a1 ·x, ..., an ·x litres of corresponding ingredients mixed for some non-negative x). In the kitchen Volodya found out that he has b1, ..., bn litres of these ingredients at his disposal correspondingly. In order to correct his algebra mistakes he ought to cook as much soup as possible in a V litres volume pan (which means the amount of soup cooked can be between 0 and V litres). What is the volume of borscht Volodya will cook ultimately?

The first line of the input contains two space-separated integers n and V (1 ≤ n ≤ 20, 1 ≤ V ≤ 10000). The next line contains n space-separated integers ai (1 ≤ ai ≤ 100). Finally, the last line contains n space-separated integers bi (0 ≤ bi ≤ 100).

Your program should output just one real number — the volume of soup that Volodya will cook. Your answer must have a relative or absolute error less than 10 - 4.

getArray :: IO [Double]
getArray = fmap (map read . words) getLine

main = do
	[n, v] <- getArray
	a <- getArray
	b <- getArray
	putStr $ show $ min v $ sum a * minimum (zipWith (/) b a)

import Text.Printf

getArray :: IO [Double]
getArray = fmap (map read . words) getLine

main = do
	[n, v] <- getArray
	a <- getArray
	b <- getArray
	printf "%.9f" $ min v $ sum a * minimum (zipWith (/) b a)

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

solve a b v = solve' 0 v
	where
		solve' x y
			| y - x < 1e-6 = x
			| ok ((x+y)/2) = solve' ((x+y)/2) y
			| otherwise = solve' x ((x+y)/2)
		ok x = all (\i -> x * (a !! i) / s <= b !! i) [0..n-1]
		s = sum a
		n = length a

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, v] = map (fromIntegral . fst . fromJust . C.readInt) . C.words $ head input
	let a = map (fromIntegral . fst . fromJust . C.readInt) . C.words $ head $ tail input
	let b = map (fromIntegral . fst . fromJust . C.readInt) . C.words $ head $ tail $ tail input
	print $ solve a b v

import List
main = interact (show.s.map read.words)
s (n:v:zs) = min (fromIntegral(sum xs)*t) (fromIntegral v) where
    xs = take n zs
    ys = drop n zs
    t = minimum $ zipWith (\y x->fromIntegral y/fromIntegral x) ys xs

{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "#1" $ assertEq  40.0 $ solve 100 [(1, 40)],
    Test "#2" $ assertEq  50.0 $ solve 100 [(1, 25), (1, 30)],
    Test "#3" $ assertEq 100.0 $ solve 100 [(1, 60), (1, 60)]
  ]

myTest :: Test
myTest  =  Test "MyTest" $ assertEq 60.0 $ solve 100 [(1, 25), (2, 40)]

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    myTest
  ]
-}
--------------------------------------------------------------------------------

solve :: (Fractional a, Num a, Ord a) => a -> [(a, a)] -> a
solve v xs  =  min v $ sum $ map ((* mn) . fst) xs
  where
    mn  =  minimum $ map (\(a,b) -> b / a) xs

main :: IO ()
main  =  do
    [n, v]  <-  fmap (map read . words) getLine
    as  <-  fmap (map read . words) getLine
    bs  <-  fmap (map read . words) getLine
    print $ solve v $ zip as bs

main = interact solve
solve input = output where
  [[n,v],a,b] = map (map (read::String->Float)) $ map words $ lines input
  output = show $ minimum (v:(answers a b))
  asum = sum a
  answers [] [] = []
  answers (x:xs) (y:ys) = (asum/x*y):(answers xs ys)

import Text.Printf

getArray :: IO [Double]
getArray = fmap (map read . words) getLine

main = do
	[n, v] <- getArray
	a <- getArray
	b <- getArray
	printf "%.1f" $ min v $ sum a * minimum (zipWith (/) b a)


On one quiet day all of sudden Mister B decided to draw angle a on his field. Aliens have already visited his field and left many different geometric figures on it. One of the figures is regular convex n-gon (regular convex polygon with n sides).That's why Mister B decided to use this polygon. Now Mister B must find three distinct vertices v1, v2, v3 such that the angle  (where v2 is the vertex of the angle, and v1 and v3 lie on its sides) is as close as possible to a. In other words, the value  should be minimum possible.If there are many optimal solutions, Mister B should be satisfied with any of them.

First and only line contains two space-separated integers n and a (3 ≤ n ≤ 105, 1 ≤ a ≤ 180) — the number of vertices in the polygon and the needed angle, in degrees.

Print three space-separated integers: the vertices v1, v2, v3, which form . If there are multiple optimal solutions, print any of them. The vertices are numbered from 1 to n in clockwise order.

NoteIn first sample test vertices of regular triangle can create only angle of 60 degrees, that's why every possible angle is correct.Vertices of square can create 45 or 90 degrees angles only. That's why in second sample test the angle of 45 degrees was chosen, since |45 - 67| < |90 - 67|. Other correct answers are: "3 1 2", "3 2 4", "4 2 3", "4 3 1", "1 3 4", "1 4 2", "2 4 1", "4 1 3", "3 1 4", "3 4 2", "2 4 3", "2 3 1", "1 3 2", "1 2 4", "4 2 1".In third sample test, on the contrary, the angle of 90 degrees was chosen, since |90 - 68| < |45 - 68|. Other correct answers are: "2 1 4", "3 2 1", "1 2 3", "4 3 2", "2 3 4", "1 4 3", "3 4 1".

{-# OPTIONS_GHC -O2 -optc-O2 -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve n a = (1, 2, (n-) $ max 0 $ subtract 1 $ round $ min (fromIntegral a :: Double) (180 - 360 / fromIntegral n) * fromIntegral n / 180)

main = do
  [n, a] <- fmap readInts B.getLine
  let (t, u, v)   = solve n a
  putStr $ show t ++ " " ++ show u ++ " " ++ show v

import Data.List
import Data.Ord

f n=180-360/n
delta n=(f n)/(n-2)
l n=map (\x->f n-x*delta n) [0..n-3]

angles n=[(1,i,i+1)|i<-[2..n-1]]

toInt (a,b,c)=[round a,round b,round c]

solve n alpha = toInt $ snd $ minimumBy (comparing fst) $ zip (map (\x->abs (alpha-x)) (l n)) (angles n)

main=do
	a<-getLine
	let [n,alpha]=map (\x->read x::Integer) $ words a
	let ans=solve (fromInteger n) (fromInteger alpha)
	putStrLn $ unwords (map show ans)

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  script
  --optimize
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package time
  --package vector
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Array.Unboxed (UArray)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap, forM_)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)
import           Data.Time.Clock
import           System.IO (stderr)
import           Data.Ratio

type N = Integer
toNum = toInte

ang :: N -> N -> Rational
ang n k = 180 + (180 % n) - (180 * k % n)

-- answer :: N -> N -> (N, N, N)
answer n a = map (ang n .- subtract a' .- abs &&& id) [3 .. n]
          $$ sort .- head .- snd .- (1,2,)
  where a' = fi a

handleInput :: ByteString -> ByteString
handleInput = words .- map toNum
            .- coerceInput answer
            .- showIt .- pack
            -- .- map (show .- pack) .- unlines

showIt (a, b, c) = show a ++ " " ++ show b ++ " " ++ show c

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f (a:b:xs) = f a b
coerceInput _ _ = error "invalid input"

main :: IO ()
main = do
  st <- getCurrentTime
  st `seq` interact handleInput
  ed <- getCurrentTime
  BS.hPutStrLn stderr $ pack ""
  BS.hPutStrLn stderr . pack $ show (ed `diffUTCTime` st)

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-

($$) :: a -> (a -> b) -> b
($$) = flip ($)
infixl 0 $$

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

import Control.Applicative( (<$>))
import Data.Ratio

main = do
    [n_ , angle_] <- map read . words <$> getLine
    let
	angle = angle_ % 1

	n = n_%1

	innerAngle = (180 * (n-2) ) / n

	partAngle = innerAngle / (n-2)

	v3 = let
		    q = 1 `max` (round $ angle / partAngle)
		    a1 = partAngle*(fromIntegral q)
		    a2 = partAngle*(fromIntegral $ q+1)
	    in
		    if abs (angle-a1) < abs (angle-a2)
			then 3 `max` (n_-(q-1))
			else 3 `max` (n_-q)
    putStr ("1 2 "++(show v3))

import Control.Applicative( (<$>))

main = do
    [n_ , angle_] <- map read . words <$> getLine
    let
	innerAngle = (180 * (n_-2) ) `div` n_

	partAngle = innerAngle `div` (n_-2)

	v3 = let
		    q = 1 `max` (angle_ `quot` partAngle)
		    a1 = partAngle*q
		    a2 = partAngle*(q+1)
	    in
		    if abs (angle_-a1) < abs (angle_-a2)
			then n_-(q-1)
			else n_-q
    putStr ("1 2 "++(show v3))

import Control.Applicative( (<$>))

main = do
    [n_ , angle_] <- map read . words <$> getLine
    let
	innerAngle = (180 * (n_-2) ) `div` n_

	partAngle = innerAngle `div` (n_-2)

	v3 = let
		    (q,r) = angle_ `quotRem` partAngle
		    a1 = partAngle*q
		    a2 = partAngle*q+1
	    in
		    if abs (angle_-a1) < abs (angle_-a2)
			then n_-q+1
			else n_-q
    putStr ("1 2 "++(show v3))

import Control.Applicative( (<$>))

main = do
    [n_ , angle_] <- map read . words <$> getLine
    let
	innerAngle = (180 * (n_-2) ) `div` n_

	partAngle = innerAngle `div` (n_-2)

	v3 = let
		    (q,r) = angle_ `quotRem` partAngle
		    a1 = partAngle*q
		    a2 = partAngle*(q+1)
	    in
		    if abs (angle_-a1) < abs (angle_-a2)
			then n_-q+1
			else n_-q
    putStr ("1 2 "++(show v3))


This is an interactive problem. Remember to flush your output while communicating with the testing program. You may use fflush(stdout) in C++, system.out.flush() in Java, stdout.flush() in Python or flush(output) in Pascal to flush the output. If you use some other programming language, consult its documentation. You may also refer to the guide on interactive problems: https://codeforces.com/blog/entry/45307.The jury guessed some array $$$a$$$ consisting of $$$6$$$ integers. There are $$$6$$$ special numbers — $$$4$$$, $$$8$$$, $$$15$$$, $$$16$$$, $$$23$$$, $$$42$$$ — and each of these numbers occurs in $$$a$$$ exactly once (so, $$$a$$$ is some permutation of these numbers).You don't know anything about their order, but you are allowed to ask up to $$$4$$$ queries. In each query, you may choose two indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le 6$$$, $$$i$$$ and $$$j$$$ are not necessarily distinct), and you will get the value of $$$a_i \cdot a_j$$$ in return.Can you guess the array $$$a$$$?The array $$$a$$$ is fixed beforehand in each test, the interaction program doesn't try to adapt to your queries.

NoteIf you want to submit a hack for this problem, your test should contain exactly six space-separated integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_6$$$. Each of $$$6$$$ special numbers should occur exactly once in the test. The test should be ended with a line break character.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

import System.IO

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

numbers = [ 4, 8, 15, 16, 23, 42 ]

main = do
	as <- solveHalf 0
	bs <- solveHalf 3
	putStrLn $ ( "! " ++ ) $ unwords $ map show $ as ++ bs

solveHalf base = do
	p <- ask $ base + 0
	q <- ask $ base + 1
	return $ determin p q

determin ( a, b ) ( x, y )
	| a == x = [ b, x, y ]
	| a == y = [ b, y, x ]
	| b == x = [ a, x, y ]
	| b == y = [ a, y, x ]

ask i = do
	putStrLn $ ( "? " ++ ) $ unwords $ map show $ [ i + 1, i + 2 ]
	hFlush stdout
	a <- readInt
	return $ head $ do
		x <- numbers
		y <- numbers
		guard $ x * y == a
		return ( x, y )


Andryusha goes through a park each day. The squares and paths between them look boring to Andryusha, so he decided to decorate them.The park consists of n squares connected with (n - 1) bidirectional paths in such a way that any square is reachable from any other using these paths. Andryusha decided to hang a colored balloon at each of the squares. The baloons' colors are described by positive integers, starting from 1. In order to make the park varicolored, Andryusha wants to choose the colors in a special way. More precisely, he wants to use such colors that if a, b and c are distinct squares that a and b have a direct path between them, and b and c have a direct path between them, then balloon colors on these three squares are distinct.Andryusha wants to use as little different colors as possible. Help him to choose the colors!

The first line contains single integer n (3 ≤ n ≤ 2·105) — the number of squares in the park. Each of the next (n - 1) lines contains two integers x and y (1 ≤ x, y ≤ n) — the indices of two squares directly connected by a path. It is guaranteed that any square is reachable from any other using the paths.

In the first line print single integer k — the minimum number of colors Andryusha has to use. In the second line print n integers, the i-th of them should be equal to the balloon color on the i-th square. Each of these numbers should be within range from 1 to k.

NoteIn the first sample the park consists of three squares: 1 → 3 → 2. Thus, the balloon colors have to be distinct.    Illustration for the first sample. In the second example there are following triples of consequently connected squares:   1 → 3 → 2  1 → 3 → 4  1 → 3 → 5  2 → 3 → 4  2 → 3 → 5  4 → 3 → 5  We can see that each pair of squares is encountered in some triple, so all colors have to be distinct.    Illustration for the second sample. In the third example there are following triples:   1 → 2 → 3  2 → 3 → 4  3 → 4 → 5  We can see that one or two colors is not enough, but there is an answer that uses three colors only.    Illustration for the third sample.

-- Codeforces Round #403 (Div. 2)
-- C. Andryusha and Colored Balloons
-- http://codeforces.com/contest/782/problem/C

import Control.Exception
import Control.Monad
import Data.Tuple
import Data.Array
import Data.Maybe
import Data.Foldable (toList)
import qualified Data.IntSet as Set
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

type Edge = (Int, Int)
type Graph = Array Int [Int]
type Visited = Set.IntSet
type ParentMapping = Array Int Int

buildG :: [Edge] -> Int -> Graph
buildG es n = accumArray (flip (:)) [] (1,n) es

main = do
    n <- getInt                             -- input
    edges <- replicateM (n-1) $ do
        [u,v] <- getInts
        return (u,v)
    let edges' = edges ++ map swap edges    -- construct the graph
    let graph = buildG edges' n
    let k = maxOutdegree graph + 1          -- calculate k
    let (colors,_,_) = colorize graph n k   -- colorize the graph
    print k                                 -- output
    forM [1..n] $ \i -> putStr (show (colors Map.! i)) >> putChar ' '

maxOutdegree :: Graph -> Int
maxOutdegree = maximum . map length . elems

colorize :: Graph -> Int -> Int -> (Map.Map Int Int, Visited, [Int])
colorize g n k = foldl visit (table0,Set.empty,cycle [1..k]) (preorder g 1) where
    table0 = Map.fromList [(v,0) | v <- [1..n]]
    parents = array (1,n) (preorder g 1)
    visit (table,visited,colors) (v,parent)
        | v `Set.member` visited = (table,visited,colors)
        | otherwise = (Map.insert v (head colors') table, v `Set.insert` visited, tail colors')
        where colors' = dropWhile (\c -> c == table Map.! (parents ! v) || c == table Map.! (parents ! (parents ! v))) colors

preorder :: Graph -> Int -> [(Int,Int)]
preorder g v0 = toList $ bfs Seq.empty [(v0,v0)] where
    bfs nodes [] = nodes
    bfs nodes queue = bfs (nodes Seq.>< Seq.fromList queue) (concatMap nexts queue)
    nexts (v,parent) = map (\u -> (u,v)) $ filter (/= parent) (g ! v)

-- Codeforces Round #403 (Div. 2)
-- C. Andryusha and Colored Balloons
-- http://codeforces.com/contest/782/problem/C

import Control.Exception
import Control.Monad
import Data.Tuple
import Data.Array
import Data.Maybe
import Data.Foldable (toList)
import qualified Data.IntSet as Set
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

type Edge = (Int, Int)
type Graph = Array Int [Int]
type Visited = Set.IntSet

buildG :: [Edge] -> Int -> Graph
buildG es n = accumArray (flip (:)) [] (1,n) es

main = do
    -- input
    n <- getInt
    edges <- replicateM (n-1) $ do
        [u,v] <- getInts
        return (u,v)
    -- construct the graph
    let edges' = edges ++ map swap edges
    let graph = buildG edges' n
    -- calculate k
    let k = maxOutdegree graph + 1
    -- colorize the graph
    let (colors,_) = colorize graph n k
    evaluate colors
    -- output
    print k
    forM [1..n] $ \i -> putStr (show (colors Map.! i)) >> putChar ' '

maxOutdegree :: Graph -> Int
maxOutdegree = maximum . map length . elems

colorize :: Graph -> Int -> Int -> (Map.Map Int Int, Visited)
colorize g n k = foldl visit (table0,Set.empty) (zip (preorder g 1) (cycle [1..k])) where
    table0 = Map.fromList [(v,0) | v <- [1..n]]
    visit (table,visited) ((v,parent),color)
        | v `Set.member` visited = (table,visited)
        | otherwise = (Map.insert v color table, v `Set.insert` visited)

preorder :: Graph -> Int -> [(Int,Int)]
preorder g v0 = toList $ bfs Seq.empty [(v0,v0)] where
    bfs nodes [] = nodes
    bfs nodes queue = bfs (nodes Seq.>< Seq.fromList queue) (concatMap nexts queue)
    nexts (v,parent) = map (\u -> (u,v)) $ filter (/= parent) (g ! v)

-- Codeforces Round #403 (Div. 2)
-- C. Andryusha and Colored Balloons
-- http://codeforces.com/contest/782/problem/C

import Control.Exception
import Control.Monad
import Data.Tuple
import Data.Array
import Data.Maybe
import Data.Foldable (toList)
import qualified Data.IntSet as Set
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

type Edge = (Int, Int)
type Graph = Array Int [Int]
type Visited = Set.IntSet
type ParentMapping = Array Int Int

buildG :: [Edge] -> Int -> Graph
buildG es n = accumArray (flip (:)) [] (1,n) es

main = do
    n <- getInt                             -- input
    edges <- replicateM (n-1) $ do
        [u,v] <- getInts
        return (u,v)
    let edges' = edges ++ map swap edges    -- construct the graph
    let graph = buildG edges' n
    let k = maxOutdegree graph + 1          -- calculate k
    let (colors,_,_) = colorize graph n k   -- colorize the graph
    print k                                 -- output
    forM [1..n] $ \i -> putStr (show (colors Map.! i)) >> putChar ' '

maxOutdegree :: Graph -> Int
maxOutdegree = maximum . map length . elems

colorize :: Graph -> Int -> Int -> (Map.Map Int Int, Visited, [Int])
colorize g n k = foldl visit (table0,Set.empty,cycle [1..k]) (preorder g 1) where
    table0 = Map.fromList [(v,0) | v <- [1..n]]
    parents = array (1,n) (preorder g 1)
    visit (table,visited,colors) (v,parent)
        | v `Set.member` visited = (table,visited,colors)
        | otherwise = (Map.insert v color table, v `Set.insert` visited, tail colors)
        where color = head $ dropWhile (\c -> c == table Map.! (parents ! v) || c == table Map.! (parents ! (parents ! v))) colors

preorder :: Graph -> Int -> [(Int,Int)]
preorder g v0 = toList $ bfs Seq.empty [(v0,v0)] where
    bfs nodes [] = nodes
    bfs nodes queue = bfs (nodes Seq.>< Seq.fromList queue) (concatMap nexts queue)
    nexts (v,parent) = map (\u -> (u,v)) $ filter (/= parent) (g ! v)


The Dogeforces company has $$$k$$$ employees. Each employee, except for lower-level employees, has at least $$$2$$$ subordinates. Lower-level employees have no subordinates. Each employee, except for the head of the company, has exactly one direct supervisor. The head of the company is a direct or indirect supervisor of all employees. It is known that in Dogeforces, each supervisor receives a salary strictly more than all his subordinates.The full structure of the company is a secret, but you know the number of lower-level employees and for each pair of lower-level employees, the salary of their common supervisor is known (if there are several such supervisors, then the supervisor with the minimum salary). You have to restore the structure of the company.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 500$$$) — the number of lower-level employees. This is followed by $$$n$$$ lines, where $$$i$$$-th line contains $$$n$$$ integers $$$a_{i,1}, a_{i,2}, \dots, a_{i,n}$$$ ($$$1 \le a_{i,j} \le 5000$$$) — salary of the common supervisor of employees with numbers $$$i$$$ and $$$j$$$. It is guaranteed that $$$a_{i,j} = a_{j,i}$$$. Note that $$$a_{i,i}$$$ is equal to the salary of the $$$i$$$-th employee.

In the first line, print a single integer $$$k$$$ — the number of employees in the company. In the second line, print $$$k$$$ integers $$$c_1, c_2, \dots, c_k$$$, where $$$c_i$$$ is the salary of the employee with the number $$$i$$$. In the third line, print a single integer $$$r$$$ — the number of the employee who is the head of the company. In the following $$$k-1$$$ lines, print two integers $$$v$$$ and $$$u$$$ ($$$1 \le v, u \le k$$$) — the number of the employee and his direct supervisor. Note that the lower-level employees have numbers from $$$1$$$ to $$$n$$$, and for the rest of the employees, you have to assign numbers from $$$n+1$$$ to $$$k$$$. If there are several correct company structures, you can print any of them.

NoteOne of the possible structures in the first example:

import Control.Monad
import Data.Maybe
import Data.List
import Data.Foldable
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

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

type State = Seq.Seq (Int, Int, Int)

changeTop :: Int -> Int -> State -> State
changeTop top = Seq.adjust' (\(val, _, par) -> (val, top, par))

findTop :: Int -> State -> (Int, Int, State)
findTop i s
  | i == t = (v, t, s)
  | otherwise = (topVal, top, changeTop top i seq')
  where
  (v, t, _) = Seq.index s i
  (topVal, top, seq') = findTop t s

changePar :: Int -> Int -> State -> State
changePar par = Seq.adjust' (\(val, _, _) -> (val, par, par))

merge :: State -> (Int, Int, Int) -> State
merge s (value, i, j)
  | pi == pj = seq''
  | value > vi && value > vj = (changePar k pj $ changePar k pi seq'') Seq.|> (value, k, k)
  | value == vi = changePar pi pj seq''
  | otherwise = changePar pj pi seq''
  where
  (vi, pi, seq') = findTop i s
  (vj, pj, seq'') = findTop j seq'
  k = Seq.length s

main :: IO ()
main = do
  [n] <- getInts
  ts <- sort . concat <$> (forM [1..n] $ \i -> map (\(j, x) -> (x, i, j)) . zip [1..n] <$> getInts)
  let
    (s1, s2) = partition (\(_, i, j) -> i == j) ts
    g1 (x, _, _) = x
    g2 (_, y, _) = y
    g3 (_, _, z) = z
    s = foldl' merge (Seq.fromList $ sortBy (\p1 p2 -> compare (g2 p1) (g2 p2)) $ (0, 0, 0) : s1) s2
    k = Seq.length s - 1
    results = tail $ toList s
  C.putStrLn $ C.pack $ show k
  C.putStrLn $ C.pack $ unwords $ map show $ map g1 results
  C.putStrLn $ C.pack $ show k
  mapM_ (\(u, v) -> C.putStrLn $ C.pack $ show u ++ " " ++ show v) $ zip [1..k-1] $ map g3 results

{-# LANGUAGE ScopedTypeVariables #-}
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
import Data.Array.IO.Safe

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  aLi <- replicateM n $ listArray (1, n) <$> readInts
  let
    a :: Array Int (UArray Int Int)
    a = listArray (1, n) aLi
    newArr = lift $ newArray (1, 2*n) (0-1) :: SIO (IOUArray Int Int)
  sals <- newArr
  supervisor <- newArr
  directSupervisor <- newArr
  forM_ [1..n] $ \i -> lift $ do
    writeArray sals i $ a ! i ! i
    writeArray supervisor i i
  let
    toMerge = stableBucketSortOn fst (1, 5000)
      $ [(a ! i ! j, (i, j)) | i <- [1..n], j <- [i+1 .. n]]
  let
    highestSupervisor :: Int -> IO Int
    highestSupervisor ix = do
      sup1 <- readArray supervisor ix
      sup2 <- readArray supervisor sup1
      writeArray supervisor ix sup2
      if  sup1 == ix
        then  pure ix
        else  highestSupervisor sup1
    merge :: Int -> (Int, (Int, Int)) -> IO Int
    merge prevCt (newSal, (i, j)) = do
      ix <- highestSupervisor i
      jx <- highestSupervisor j
      salix <- readArray sals ix
      saljx <- readArray sals jx
      if  ix == jx
        then  pure prevCt
        else  if  salix == newSal
        then  writeArray supervisor jx ix >> writeArray directSupervisor jx ix >> pure prevCt
        else  if  saljx == newSal
        then  writeArray supervisor ix jx >> writeArray directSupervisor ix jx >> pure prevCt
        else  do
        let  currCt = prevCt + 1
        writeArray supervisor ix currCt
        writeArray supervisor jx currCt
        writeArray directSupervisor ix currCt
        writeArray directSupervisor jx currCt
        writeArray supervisor currCt currCt
        writeArray sals currCt newSal
        pure currCt
  numEmployees <- lift $ foldM merge n toMerge
  putInts [numEmployees]
  salaryList <- lift $ forM [1..numEmployees] $ readArray sals
  putInts salaryList
  putInts [numEmployees]
  forM_ [1 .. numEmployees - 1] $ \ix -> do
    par <- lift $ readArray directSupervisor ix
    putInts [ix, par]

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.Maybe
import Data.List
import Data.Foldable
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

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

type State = Seq.Seq (Int, Int, Int)

changeTop :: Int -> Int -> State -> State
changeTop top = Seq.adjust' (\(val, _, par) -> (val, top, par))

findTop :: Int -> State -> (Int, Int, State)
findTop i s
  | i == t = (v, t, s)
  | otherwise = (topVal, top, changeTop top i seq')
  where
  (v, t, _) = Seq.index s i
  (topVal, top, seq') = findTop t s

changePar :: Int -> Int -> State -> State
changePar par = Seq.adjust' (\(val, _, _) -> (val, par, par))

merge :: State -> (Int, Int, Int) -> State
merge s (value, i, j)
  | pi == pj = seq''
  | value > vi && value > vj = (changePar k pj $ changePar k pi seq'') Seq.|> (value, k, k)
  | value == vi = changePar pi pj seq''
  | otherwise = changePar pj pi seq''
  where
  (vi, pi, seq') = findTop i s
  (vj, pj, seq'') = findTop j seq'
  k = Seq.length s

main :: IO ()
main = do
  [n] <- getInts
  ts <- sort . concat <$> (forM [1..n] $ \i -> map (\(j, x) -> (x, i, j)) . zip [1..n] <$> getInts)
  let
    (s1, s2) = splitAt n ts
    g1 (x, _, _) = x
    g2 (_, y, _) = y
    g3 (_, _, z) = z
    s = foldl' merge (Seq.fromList $ sortBy (\p1 p2 -> compare (g2 p1) (g2 p2)) $ (0, 0, 0) : s1) s2
    k = Seq.length s - 1
    results = tail $ toList s
  C.putStrLn $ C.pack $ show k
  C.putStrLn $ C.pack $ unwords $ map show $ map g1 results
  C.putStrLn $ C.pack $ show k
  mapM_ (\(u, v) -> C.putStrLn $ C.pack $ show u ++ " " ++ show v) $ zip [1..k-1] $ map g3 results

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

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

main :: IO ()
main = do
  [n] <- getInts
  ts <- sort . concat <$> (forM [1..n] $ \i -> map (\(j, x) -> (x, i, j)) . zip [1..n] <$> getInts)
  let (s1, s2) = partition (\(_, i, j) -> i == j) ts
      g (x, _, _) = x
      cmp t1 t2 = g t1 == g t2
      gs = groupBy cmp s2
      m = length gs
      z = n + m
  C.putStrLn $ C.pack $ show z
  let
    findTop mp i
      | p == i = (mp, p)
      | otherwise = (update p' i mp', p')
      where
      p = mp M.! i
      (mp', p') = findTop mp p
    update x = M.update (\_ -> Just x)
    addOne pr (k, ts) = foldl' mergeTwo pr ts
      where
      mergeTwo (ss, mp, ps) (x, i, j) = (ss', mp', ps')
        where
        (ps1, p) = findTop ps i
        (ps2, q) = findTop ps1 j
        ps' = update k p $ update k q ps2
        mp' = update k p $ update k q mp
        ss' = M.alter (\_ -> Just x) k ss
    inits = M.fromList $ zip [1..z] [1..z]
    (salaries, parents, _) = foldl' addOne (ss, inits, inits) $ zip [n+1..] gs
    ss = foldl' (\mp (x, i, _) -> M.alter (\_ -> Just x) i mp) M.empty s1
  C.putStrLn $ C.pack $ unwords $ map show $ M.elems salaries
  C.putStrLn $ C.pack $ show z
  mapM_ (\(i, j) -> C.putStrLn $ C.pack $ show i ++ " " ++ show j) $ take (z - 1) $ M.toList parents


This problem is interactive.We have hidden an array $$$a$$$ of $$$n$$$ pairwise different numbers (this means that no two numbers are equal). You can get some information about this array using a new device you just ordered on Amazon. This device can answer queries of the following form: in response to the positions of $$$k$$$ different elements of the array, it will return the position and value of the $$$m$$$-th among them in the ascending order.Unfortunately, the instruction for the device was lost during delivery. However, you remember $$$k$$$, but don't remember $$$m$$$. Your task is to find $$$m$$$ using queries to this device. You can ask not more than $$$n$$$ queries.Note that the array $$$a$$$ and number $$$m$$$ are fixed before the start of the interaction and don't depend on your queries. In other words, interactor is not adaptive.Note that you don't have to minimize the number of queries, and you don't need to guess array $$$a$$$. You just have to guess $$$m$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1\le k < n \le 500$$$) — the length of the array and the number of the elements in the query. It is guaranteed that number $$$m$$$ satisfies $$$1\le m \le k$$$, elements $$$a_1, a_2, \dots, a_n$$$ of the array satisfy $$$0\le a_i \le 10^9$$$, and all of them are different.

{-- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Exception
import Data.Either
import Data.List
import System.IO

data InvalidQuery =
    InvalidQuery
    deriving (Show)

instance Exception InvalidQuery

query :: [Integer] -> IO Integer
query xs = do
    putStr "? "
    putStrLn $ unwords . map show $ xs
    hFlush stdout
    ps <- map read . words <$> getLine
    case ps of
        [-1] -> throwIO InvalidQuery
        _ -> return $ last ps

solve n k = do
    vs <- mapM query [[1 .. i] ++ [i + 2 .. k + 1] | i <- [0 .. k]]
    putStr "! "
    print $ length $ last $ group $ sort vs
    hFlush stdout

main = do
    (n:k:_) <- map read . words <$> getLine
    catch (solve n k) (\InvalidQuery -> return ())


The classic programming language of Bitland is Bit++. This language is so peculiar and complicated.The language is that peculiar as it has exactly one variable, called x. Also, there are two operations:  Operation ++ increases the value of variable x by 1.  Operation -- decreases the value of variable x by 1. A statement in language Bit++ is a sequence, consisting of exactly one operation and one variable x. The statement is written without spaces, that is, it can only contain characters "+", "-", "X". Executing a statement means applying the operation it contains.A programme in Bit++ is a sequence of statements, each of them needs to be executed. Executing a programme means executing all the statements it contains.You're given a programme in language Bit++. The initial value of x is 0. Execute the programme and find its final value (the value of the variable when this programme is executed).

Print a single integer — the final value of x.

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

f :: [String] -> Int
f [] = 0
f (x:xs)
  | '+' `elem` x = f xs + 1
  | '-' `elem` x = f xs - 1

import Control.Applicative

process a = a2-a1
  where a1= length $ filter (\z->z=="--X"||z=="X--") a
        a2= length $ filter (\z->z=="++X"||z=="X++") a

main::IO ()
main=do
    getLine
    a<-lines <$> getContents
    print $ process a

main :: IO ()
main = interact $ show . solve . tail . lines

solve :: [String] -> Int
solve  = foldl run 0

run :: Int -> String -> Int
run x (_ : '+' : _) = x + 1
run x (_ : '-' : _) = x - 1

import Control.Monad
main = do
  n<-getLine
  arr<-replicateM (read n) getLine
  print ( (length (filter f arr)) -  (length (filter f' arr)) )
        where
                f x = (x=="X++") || (x=="++X")
                f' x = not (f x)

import Control.Monad (liftM)

solve :: [String] -> Int
solve []  =  0
solve (l:s)
  | '-' `elem` l  =  solve s - 1
  | '+' `elem` l  =  solve s + 1
  | otherwise  =  solve s

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

module Main where

import Control.Monad (replicateM)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  inp <- replicateM n getLine
  let pluses = length . filter (elem '+') $ inp
      minuses = n - pluses
  print (pluses - minuses)

main :: IO ()
main = do
    n <- getLine
    interpBit 0 $ read n

interpBit :: Int -> Int -> IO ()
interpBit m 0 = print m >>= return
interpBit m n = do
    [_,o,_] <- getLine
    if o == '+'
      then interpBit (m + 1) (n - 1)
      else interpBit (m - 1) (n - 1)

import Data.List

main = do
	n <- getInt
	operations <- sequence $ map (\i -> getLine) [1..n]
	let res = foldr (\curr acc -> if (curr !! 1 == '+') then acc + 1 else acc - 1) 0 operations
	putStrLn $ show res

getInt::IO Int
getInt = do
	res <- getLine
	return $ readInt res

readInt::String -> Int
readInt str = read str

import Control.Monad
import Control.Applicative

main = do
  n <- read <$> getLine
  ss <- replicateM n getLine
  print $ solve ss

solve :: [String] -> Int
solve ss = (length (filter ((1==).op) ss)) - (length (filter ((-1==).op) ss))

op xs
  | xs == "++X" = 1
  | xs == "--X" = -1
  | xs == "X++" = 1
  | xs == "X--" = -1

solve :: [String] -> Int
solve [] = 0
solve (x:xs)
    | x !! 1 == '+' = 1 + solve xs
    | otherwise = solve xs - 1

parse :: String -> String
parse = show . solve . tail . words

main = interact parse

solve :: String -> Int
solve all =
    foldl (\acc x-> if elem '+' x then acc + 1 else acc - 1) 0 $ tail$lines all
main = do
    all <- getContents
    print $ solve all

main = interact f

f = show . sum . map g . tail . lines

g (_:c:_) | c == '+' = 1
          | otherwise = -1

module Main where

solve line =
    plus - minus
    where
        plus = length $ filter (\x -> elem '+' x) line
        minus = length $ filter (\x -> elem '-' x) line

main = do
    _ <- getLine
    rules <- getContents
    print $ solve $ lines rules

main = interact $ show . sum . map (\s -> if '+' `elem` s then 1 else -1) . tail . lines

main = interact $ show . sum . map (\x -> if elem '-' x then -1 else 1) . tail . lines

import Data.List (foldl')

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

solve :: [String] -> Int
solve = foldl' f 0
  where f n "++X" = n + 1
        f n "X++" = n + 1
        f n "--X" = n - 1
        f n "X--" = n - 1
        f n _ = n

import Prelude hiding (readList)
import Control.Monad

readList :: Read a => IO [a]
readList = fmap (fmap read . words) getLine

readList' :: Read a => a -> IO [a]
readList' _ = readList

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

interpLine :: Int -> String -> Int
interpLine x s
  | '+' `elem` s = x+1
  | otherwise    = x-1

main :: IO ()
main = do
  [n] <- readList' (undefined::Int)
  lines <- replicateM n getLine
  print $ foldl interpLine 0 lines

import Control.Monad

main = getLine >>= (flip replicateM $ getLine).read >>= putStrLn.show.solve

operate (o:os)
        | o == '+' =  1
        | o == '-' = -1

solve (op:[])  =  operate $ tail op
solve (op:ops) = (operate $ tail op) + (solve ops)

main = readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \x-> interact $ show.solve. take (read x) . lines
  where
    solve=foldr f 0
      where f x y | x== "++X" || x== "X++"= 1+y
              | otherwise= y-1

main=interact$show.sum.map(\x->if x!!1=='+' then 1 else -1).tail.lines

f s | elem '+' s = 1
	| otherwise  = -1
main = interact $ show . sum . map f . tail . lines

f s= if s!!1=='+' then 1 else -1
main=interact$show.sum.map f.tail.lines

import Data.List
import Data.List.Split
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Char as C

(|>) = flip ($)

main = interact process

process contents = let
  ls = contents |> lines |> tail
  in solve ls |> show

solve ls = let
  plus = ls |> filter ('+' `elem`) |> length
  minus = ls |> filter ('-' `elem`) |> length
  in plus - minus

module Main (main)
    where

import Data.List (sort, group)
import Control.Monad (replicateM)

main :: IO ()
main = print . exec . map (head . tail) =<< flip replicateM getLine =<< readLn
    where exec = count . map (pred . length) . group . sort . ("+-"++)
          count [p,m] = p - m

import qualified Data.Map as Map
import Control.Monad

g [] = 0
g (x : xs) = do
  case Map.lookup x (Map.fromList [("++X", 1), ("X++", 1), ("--X", -1), ("X--", -1)]) of
    Just y -> y + (g $ xs)
    Nothing -> g $ xs

main = do
  b <- readLn
  inputs <- replicateM b getLine
  putStrLn $ show $ g inputs

main :: IO ()
main = getLine >> getContents >>= print . foldl solve 0 . lines

solve :: Int -> String -> Int
solve a "X++" = a+1
solve a "++X" = a+1
solve a "X--" = a-1
solve a "--X" = a-1

import           Control.Monad                  ( replicateM )
folder :: Int -> String  -> Int
folder a s = if '+' `elem` s then (a + 1) else (a - 1)

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    ans <- foldl folder 0 <$> ( replicateM n getLine )
    print ans

import Data.List (foldl')

main :: IO ()
main = interact $ show . foldl' (+) 0 . map solve . tail . words

solve :: String -> Int
solve (_:'+':_) = 1
solve (_:'-':_) = -1

-- import Debug.Trace
-- import System.IO.Unsafe
-- import Text.Printf
import System.IO
import Control.Monad
import Data.List

glwr = fmap (map read . words) getLine

main = do
  hSetBuffering stdout NoBuffering
  solve

solve :: IO ()
solve = do
  n:_ <- glwr
  strs <- forM [1..n] $ const getLine
  print $ bit n strs

bit :: Int -> [String] -> Int
bit n = foldr ko 0

ko s acc = case s!!1 of
  '+' -> acc+1
  _   -> acc-1

import Control.Monad

data Operation = Inc | Dec deriving (Show, Eq, Ord)

parseLine :: String -> Operation
parseLine x
    | x `elem` ["++X", "X++"] = Inc
    | x `elem` ["--X", "X--"] = Dec
    | otherwise = error "Unparseble entity"

eval :: Int -> [Operation] -> Int
eval y [] = y
eval y (x:xs)
    | x == Inc = eval (y + 1) xs
    | x == Dec = eval (y - 1) xs

readNLines :: Int -> IO [String]
readNLines n = replicateM n getLine

main :: IO()
main = do
    n <- readLn :: IO Int
    args <- readNLines n
    print $ eval 0 $ map parseLine args

import Control.Monad
main = (getLine >>= (\l -> replicateM (read l) getLine)) >>= (print . foldr (\l -> if elem '-' l then pred else succ) 0)

isPlus    :: String -> Bool
isPlus xs
 | (hxs == '+') || (lxs == '+') = True
 | otherwise                    = False
 where hxs = head xs
       lxs = last xs

isSub :: String -> Bool
isSub xs
 | (hxs == '-') || (lxs == '-') = True
 | otherwise                    = False
 where hxs = head xs
       lxs = last xs

getInput    :: String -> [String]
getInput xs = tail $ lines xs

operate    :: [String] -> Int
operate [] = 0
operate (x:xs)
 | isPlus x = 1 + operate xs
 | isSub x  = (operate xs) - 1

main :: IO ()
main = do n <- getContents
          putStr $ show $ operate $ getInput n

import Control.Monad
import Data.List

convert :: String -> Int
convert x = if x!!1 == '+' then 1 else -1

main :: IO ()
main = do
    str <- getLine
    inputs <- replicateM (read str) getLine
    print $ sum $ map convert inputs

s x=show$length [i | i<-tail$lines x,elem '+' i] - 	length [i | i<-tail$lines x,elem '-' i]
main=interact$s

main = interact $ show . sum . map (\s -> if '+' `elem` s then 1 else -1) . tail . lines

main=interact$show.sum.map(\x->if x!!1=='+' then 1 else -1).tail.lines

while i n = do
    if i == 0 then
        print n
    else do
        s <- getLine
        if s!!1 == '-' then
            while (i - 1) (n - 1)
        else
            while (i - 1) (n + 1)
main = do
    input <- getLine
    let n = read input :: (Int)
    while n 0

import Data.Char

ans str = foldl check 0 str
check a xs
    | elem '+' xs = a+1
    | otherwise = a-1

main = do
    n<-getLine
    m<-getContents
    print.ans $ lines m

solve' :: String -> Int
solve' str = case str of
				"X++" -> 1
				"X--" -> -1
				"++X" -> 1
				"--X" -> -1
				otherwise -> 0

solve :: IO String -> IO Int
solve x = fmap (sum.map solve'.words) x

main :: IO()
main = solve getContents >>= print

parseOp :: String -> Int
parseOp "X++" = 1
parseOp "++X" = 1
parseOp "X--" = -1
parseOp "--X" = -1
parseOp _ = 0

main :: IO ()
main = do
	cs <- getContents
	print $ sum $ map parseOp $ words cs

import Data.List
solve :: [String] -> Int
solve = sum . map (\x -> if "++" `isInfixOf` x then 1 else -1)

work :: String -> String
work = show . solve . tail .lines

main :: IO ()
main = interact work

import Data.List
import Data.Char

main = do
	input <- getContents
	putStrLn $ show $ answer $ tail $ lines input

answer x = (length $ filter (isInfixOf "++") x) - (length $ filter (isInfixOf "--") x)

import Control.Monad

solve :: [[Char]] -> [Char]
solve = unwords

count :: [Char] -> Int
count xs = foldl (\acc elem -> if elem == '+' then acc+1 else acc) 0 xs

main = do
    input1 <- getLine
    let num = (read input1 :: Int)
    lines <- replicateM num getLine
    let s = (count (unwords lines)) - num
    print s

recognize (x:y:z:_)
	|(x:[y])=="++" || (y:[z])=="++" = "++"
	|otherwise = "--"
solve []=0
solve (x:xs)
	|x=="++" =1+solve xs
	|otherwise=0-1+solve xs
main=getLine>>=(\x->interact$show.solve.map recognize.take (read x::Int).lines)

main = interact f

f = show . sum . map g . tail . lines

g (_:c:_) | c == '+' = 1
          | otherwise = -1

main = do
    getLine
    ls <- fmap lines getContents

    let
        c1 = length $ filter (elem '+') ls
        c2 = length $ filter (elem '-') ls
    print $ c1 - c2

import Control.Monad
import Data.List

f :: [String] -> Int
f (a:rst)
  | "++" `isInfixOf` a = 1 + f rst
  | "--" `isInfixOf` a = (-1) + f rst
f [] = 0

main :: IO ()
main = do
  numLines <- getLine
  inputs <- replicateM (read numLines) getLine
  putStrLn $ show $ f inputs

main = do
  n <- readLn
  arr <- sequence $ replicate n getLine
  let m = length (filter (`elem` ["X++", "++X"]) arr) - length (filter (`elem` ["X--", "--X"]) arr)
  print m

module Main where

solve :: [String] -> Int
solve = solve' 0
        where
          solve' x [] = x
          solve' x (s:ss)
            | s!!1 == '+' = solve' (x+1) ss
            | s!!1 == '-' = solve' (x-1) ss
            | otherwise = solve' x ss

main = getLine >> getContents >>= (print . solve . lines)

main = interact$show.sum.map (\x->if x == '+' then 1 else -1).map head.map tail.tail.lines

main = print . sum . map (\l -> if elem '+' l then 1 else -1) . tail . lines =<< getContents

main=interact$show.sum.map(\x->if x!!1=='+' then 1 else -1).tail.lines

{-
A. Bit++
=========
time limit per test: 2 seconds
memory limit per test: 256 megabytes
input: standard input
output: standard output

The classic programming language of Bitland is Bit++. This language is so peculiar and complicated.

The language is that peculiar as it has exactly one variable, called x. Also, there are two operations:

Operation ++ increases the value of variable x by 1.
Operation -- decreases the value of variable x by 1.

A statement in language Bit++ is a sequence, consisting of exactly one operation and one variable x. The statement is written without spaces, that is, it can only contain characters "+", "-", "X". Executing a statement means applying the operation it contains.

A programme in Bit++ is a sequence of statements, each of them needs to be executed. Executing a programme means executing all the statements it contains.

You're given a programme in language Bit++. The initial value of x is 0. Execute the programme and find its final value (the value of the variable when this programme is executed).

Input
------
The first line contains a single integer n (1 ≤ n ≤ 150) — the number of statements in the programme.

Next n lines contain a statement each. Each statement contains exactly one operation (++ or --) and exactly one variable x (denoted as letter «X»). Thus, there are no empty statements. The operation and the variable can be written in any order.

Output
-------
Print a single integer — the final value of x.

Sample test(s)
--------------
input
```
1
++X
```
output
```
1
```

input
```
2
X++
--X
```
output
```
0
```
-}

bitCompute :: [String] -> Int
bitCompute xs = sum $ map (\s -> if '+' `elem` s then 1 else -1) xs

main = do
  input <- getContents
  let xs = tail $ lines input
  print $ bitCompute xs

import Data.List

main = do
	n <- getInt
	operations <- sequence $ map (\i -> getLine) [1..n]
	let res = foldr (\curr acc -> if (isInfixOf "+" curr) then acc + 1 else acc - 1) 0 operations
	putStrLn $ show res

getInt::IO Int
getInt = do
	res <- getLine
	return $ readInt res

readInt::String -> Int
readInt str = read str

import Control.Applicative
main= do
	n<-read <$> getLine::IO Int
	s<- length .filter (  elem '+'). lines <$> getContents
	let t = s+s -n
	print t

import Data.Typeable

parse x = read x :: Int

solverec :: Int -> IO Int
solverec 0 = return 0
solverec x = do
    raw <- getLine
    acc <- return (if raw!!1=='+' then 1 else -1)
    sub <- solverec $ x-1
    return (acc+sub)

main = do
    raw <- getLine
    let n = parse raw
    res <- solverec n
    print res

import Data.List
main=interact$show.solve.parse
parse=map(\(_:l:_)->l).tail.lines
solve x=length p-length m where (p,m) = partition (== '+') x

import Data.Char(digitToInt)

toInt::[Char]->Int
toInt x =
 let
     toInt'::[Char]->Int->Int
     toInt' y z =
      if null y
         then z
         else toInt' (tail y) (z*10+(digitToInt (head y)-digitToInt '0'))
 in toInt' x 0

add::[Char]->Bool
add x =
 if null x
 then False
 else if (head x) == '+'
 then True
 else add (tail x)

getAddCnt::[[Char]]->Int
getAddCnt x =
 if null x
 then 0
 else if add $ head x
 then 1 + (getAddCnt $ tail x)
 else getAddCnt $ tail x

main::IO()
main =
 do
 input <- getContents
 let
  line = lines input
  n = toInt $ head line
  addCnt = getAddCnt $ tail line
  subCnt = n-addCnt
 print $ addCnt-subCnt

exec :: Int -> [String] -> Int
exec x [] = x
exec x (n:ns)
  | n !! 1 == '+' = exec (x + 1) ns
  | otherwise = exec (x - 1) ns

main = do
  n <- getLine
  interact $ show . exec 0 . lines

solve xs = sum [if x !! 1 == '+' then 1 else -1 | x <- xs]
main = interact $ show . solve . tail . lines

main = interact $ show . sum . map (\x -> if elem '-' x then -1 else 1) . tail . lines

import Control.Monad

parse s = case s of
  "++X" -> 1
  "X++" -> 1
  "--X" -> -1
  "X--" -> -1
  _ -> 0

main = do
  d <- getContents
  let (n:ls) = lines d
  let ops = map parse ls
  print $ sum ops

main :: IO ()
main = do
    n <- getLine >>= return . read
    s <- sequence $ replicate n getLine
    putStrLn $ show $ sum $ map
                            (\x -> if x == "X++" || x == "++X" then 1 else -1)
                            s

import Control.Monad

count :: Char -> [String] -> Int
count c ss = length $ filter (\s -> elem c s) ss

main = do
    input <- getLine
    commands <- replicateM (read input) getLine
    print $ (count '+' commands) - (count '-' commands)

import Control.Monad

main = getLine
    >>= return . (read :: String -> Int)
    >>= \x -> forM [1..x] (\i -> getLine >>= return . conversion)
    >>= print . sum

conversion :: String -> Int
conversion "++X" = 1
conversion "--X" = -1
conversion "X++" = 1
conversion "X--" = -1

import Control.Monad

main = interact $ show.sum.map(\x -> if( x!!1 == '-') then -1 else  1).tail.lines

main :: IO ()
main = getLine >> getContents >>= print . foldl solve 0 . lines

solve :: Int -> String -> Int
solve a "X++" = a+1
solve a "++X" = a+1
solve a "X--" = a-1
solve a "--X" = a-1

main = interact $ show . f . tail . lines

f [] = 0
f (a:b) = (if elem '+' a then 1 else -1) + f b

module Main where
import Control.Applicative
main = do
  commandCount <- read <$> getLine
  mapM (\_ -> getLine)[1..commandCount] >>= \commands -> print $ foldl interpreter 0 commands
    where interpreter x c | (c == "X++"|| c == "++X") = x + 1 | otherwise = x -1

main = do
	numberString <- getLine
	let number = read numberString :: Int
	summa number 0

summa :: Int -> Int -> IO ()
summa 0 suma = print suma
summa i suma = do
	stat <- getLine
	if elem '+' stat
		then summa (i-1) (suma+1)
		else summa (i-1) (suma-1)

main = print . sum . map (\x -> if x then 1 else -1) . map (elem '+') . tail . lines =<< getContents

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    lines <- getNLines n
    print $ execute lines

getNLines :: Int -> IO [String]
getNLines 0 = return []
getNLines n = getLine >>= \newLine ->
    fmap ([newLine] ++) $ getNLines (n - 1)

execute :: [String] -> Int
execute [] = 0
execute (ins:rest) | isInfixOf "++" ins = execute rest + 1
    | isInfixOf "--" ins = execute rest - 1

import Control.Applicative

process a = a2-a1
  where a1= length $ filter (\z->z=="--X"||z=="X--") a
        a2= length $ filter (\z->z=="--X"||z=="X--") a

main::IO ()
main=do
    getLine
    a<-lines <$> getContents
    print $ process a

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

solve :: [String] -> Int
solve xs = a - (length xs - a)
    where a = length $ filter (=="X++") xs

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    print $ solve xs

main = do
    getLine
    l <- getContents
    putStrLn $ show . sum . map convert . tail . lines $ l
        where
            convert "++X" = 1
            convert "X--" = -1

--main = interact $ show . sum . map convert . tail . lines
--    where
--        convert "++X" = 1
--        convert "X--" = -1

main = do
    l <- getContents
    putStrLn $ show . sum . map (\x -> if x == "++X" then 1 else -1) . tail . lines $ l

import Control.Monad

main = getLine >>= (flip replicateM $ getLine).read >>= putStrLn.show.solve

operate (o:os)
        | o == 'X' =  0
        | o == '+' =  1
        | o == '-' = -1

solve (op:[])  = operate op
solve (op:ops) = (operate $ tail op) + (solve ops)

import Data.Char

main = interact $ unlines . map (\s -> if foldl(\acc c -> if isUpper c then acc else False) True $ tail s then map (\c -> if isUpper c then toLower c else toUpper c) s else s) . lines

main = interact $ show . sum . map (\s -> if head s == '+' then length s else length s * (-1)) . map (filter (/='X')) . tail . lines

apply :: Int -> String -> Int
apply y (x:s:xs)
  | s == '+' = y + 1
  | s == '-' = y - 1

run :: Int -> Int -> IO Int
run m n
  | m == 0 = return n
  | otherwise = getLine >>= run (m-1) . apply n

main = getLine >>= go 0 . read where go = flip run

import Data.Char

main :: IO ()
main = interact solve

solve :: String -> String
solve (x : xs) = toUpper x : xs

main = interact $ show . f . tail . lines
f [] = 0
f (a:b) = if elem '+' a then 1 else -1


Scientists say a lot about the problems of global warming and cooling of the Earth. Indeed, such natural phenomena strongly influence all life on our planet.Our hero Vasya is quite concerned about the problems. He decided to try a little experiment and observe how outside daily temperature changes. He hung out a thermometer on the balcony every morning and recorded the temperature. He had been measuring the temperature for the last n days. Thus, he got a sequence of numbers t1, t2, ..., tn, where the i-th number is the temperature on the i-th day.Vasya analyzed the temperature statistics in other cities, and came to the conclusion that the city has no environmental problems, if first the temperature outside is negative for some non-zero number of days, and then the temperature is positive for some non-zero number of days. More formally, there must be a positive integer k (1 ≤ k ≤ n - 1) such that t1 < 0, t2 < 0, ..., tk < 0 and tk + 1 > 0, tk + 2 > 0, ..., tn > 0. In particular, the temperature should never be zero. If this condition is not met, Vasya decides that his city has environmental problems, and gets upset.You do not want to upset Vasya. Therefore, you want to select multiple values of temperature and modify them to satisfy Vasya's condition. You need to know what the least number of temperature values needs to be changed for that.

The first line contains a single integer n (2 ≤ n ≤ 105) — the number of days for which Vasya has been measuring the temperature.  The second line contains a sequence of n integers t1, t2, ..., tn (|ti| ≤ 109) — the sequence of temperature values. Numbers ti are separated by single spaces.

Print a single integer — the answer to the given task.

NoteNote to the first sample: there are two ways to change exactly one number so that the sequence met Vasya's condition. You can either replace the first number 1 by any negative number or replace the number -2 by any positive number.

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

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

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

main = do
  input <- openFile "input.txt" ReadMode
  hGetLine input
  xs <- unfoldr (B.readInt . B.dropWhile isSpace) <$> (B.hGetLine input)

  let
    a = scanl1 (+) $ map (fromEnum . (>= 0)) xs
    b = scanr1 (+) $ map (fromEnum . (<= 0)) xs

  output <- openFile "output.txt" WriteMode
  hPrint output $ minimum $ zipWith (+) a $ tail b
  hClose output

import Array (Array, (!), array, listArray)
import Char (isDigit, ord)
import Data.List (foldl1')
import IO
import Monad (liftM)
import Prelude hiding (read)

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const
infix 3 ?

minimum' :: Ord a => [a] -> a
minimum'  =  foldl1' (\a b -> a < b ? a $ b)

solve :: Int -> Array Int Int -> Int
solve n a  =  minimum' [(l ! i) + (r ! i) | i <- [1..n-1]]
  where
    l  =  array (0, n) ((0,0) : [(i, l ! (i-1) + (a ! i >= 0 ? 1 $ 0)) | i <- [1..n]])
    r  =  array (0, n) ((n,0) : [(i, r ! (i+1) + (a ! (i+1) <= 0 ? 1 $ 0)) | i <- [0..n-1]])

read :: String -> Int
read (c:s)
  | c == '-'  =  (-1) * (read' 0 s)
  | otherwise  =  read' 0 (c:s)
  where
    read' a []  =  a
    read' a (c:s)  =  read' (10 * a + ord c - ord '0') s

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    n   <-  liftM read (hGetLine hInput)
    as  <-  liftM (listArray (1,n) . map read . words) (hGetLine hInput)
    hPrint hOutput $ solve n as

    hClose hInput
    hClose hOutput

import qualified Data.ByteString.Char8 as B

main=B.readFile"input.txt">>=writeFile"output.txt".show.solve.tail.map(signum.readInt).B.words

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

solve :: [Int] -> Int
solve (x:xs) = case nonzero of
             [] -> zeronum
             _ -> (zeronum+).minimum $ zipWith (+) (scanl positive (sum[1|x>0]) nonzero) (init $ scanr negative 0 nonzero)
   where
     nonzero = filter (0/=) xs
     zeronum = sum[1|0<-x:xs]

positive x y = if y>0 then x+1 else x
negative x y = if x<0 then y+1 else y

import qualified Data.ByteString.Char8 as B

sum_lists x y = map (\(a, b) -> a+b) $ zip x y

max_val = 1000001

positive = \x -> if x < 0 then 0 else 1
negative = \x -> if x > 0 then 0 else 1

left x = scanl (+) 0 (map positive x)
right x = scanr (+) 0 (map negative x)

solve :: [Int] -> Int
solve x = foldl min max_val (init . tail $ sum_lists p1 p2)
   where
      p1 = left x
      p2 = right x

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

main=B.readFile"input.txt">>=writeFile"output.txt".show.solve.tail.map(signum.readInt).B.words

--main = do
--   handleIn <- openFile "input.txt" ReadMode
--   n' <- hGetLine handleIn
--   let n = read n' :: Int
--   t' <- hGetLine handleIn
--   let t = (map read (words t')) :: [Int]
--   handleOut <- openFile "output.txt" WriteMode
--   hPrint handleOut $ solve t
--   hFlush handleOut

import Array (Array, (!), array, listArray)
import Char (isDigit, ord)
import Data.List (foldl1')
import IO
import Monad (liftM)
import Prelude hiding (read)

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const
infix 3 ?

minimum' :: Ord a => [a] -> a
minimum'  =  foldl1' (\a b -> a < b ? a $ b)

solve :: Int -> Array Int Int -> Int
solve n a  =  minimum' [(l ! i) + (r ! i) | i <- [1..n-1]]
  where
    l  =  array (0, n) ((0,0) : [(i, l ! (i-1) + (a ! i >= 0 ? 1 $ 0)) | i <- [1..n]])
    r  =  array (0, n) ((n,0) : [(i-1, r ! i + (a ! i <= 0 ? 1 $ 0)) | i <- [1..n]])

read :: String -> Int
read s  =  read' 0 (dropWhile (not . isDigit) s)
  where
    read' a []  =  a
    read' a (c:s)
      | isDigit c  =  read' (10 * a + ord c - ord '0') s
      | otherwise  =  error ""

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    n   <-  liftM read (hGetLine hInput)
    as  <-  liftM (listArray (1,n) . map read . words) (hGetContents hInput)
    hPrint hOutput $ solve n as

    hClose hInput
    hClose hOutput

import qualified Data.ByteString.Char8 as B

main=B.readFile"input.txt">>=writeFile"output.txt".parseOutput.solve.parseInput

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

parseInput = tail.map (signum.readInt).B.words
parseOutput = show

solve :: [Int] -> Int
solve xs = case nonzero of
             [] -> zeronum
             _ -> (zeronum+).pred.minimum $ zipWith (+) (tail$scanl positive 0 nonzero) (init$scanr negative 0 nonzero)
   where
     nonzero = filter (0/=) xs
     zeronum = sum[1|0<-xs]

positive x y = if y>0 then x+1 else x
negative x y = if x<0 then y+1 else y

import qualified Data.ByteString.Char8 as B

main=B.readFile"input.txt">>=writeFile"output.txt".parseOutput.solve.parseInput

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

parseInput = map (signum.readInt).B.words
parseOutput = show

solve :: [Int] -> Int
solve xs = minimum $ zipWith (+) (scanl positive 0 xs) (scanr negative 0 xs)

positive x y = if y>=0 then x+1 else x
negative x y = if y<=0 then y+1 else x+1

import System.IO

left :: [Integer] -> [Integer] -> (Integer -> Bool) -> [Integer]
left acc [] f = acc
left (a:acc) (x:xs) f
   | not (f x) = left ( (a+1):a:acc ) xs f
   | otherwise  = left ( a:a:acc ) xs f

sum_lists :: [Integer] -> [Integer] -> [Integer]
sum_lists [] [] = []
sum_lists (x:xs) (y:ys) = (x+y):(sum_lists xs ys)

max_val = 1000001

solve :: [Integer] -> Integer
solve x = foldl min max_val (sum_lists p1 p2)
   where
      p1 = reverse (left [0] x (<0) )
      p2 = left [0] (reverse x) (>0)

main = do
   handleIn <- openFile "input.txt" ReadMode
   n' <- hGetLine handleIn
   let n = read n' :: Integer
   t' <- hGetLine handleIn
   let t = (map read (words t')) :: [Integer]
   handleOut <- openFile "output.txt" WriteMode
   hPutStrLn handleOut ( show ( solve t ) )
   hFlush handleOut


An array is beautiful if both of the following two conditions meet:  there are at least $$$l_1$$$ and at most $$$r_1$$$ elements in the array equal to its minimum;  there are at least $$$l_2$$$ and at most $$$r_2$$$ elements in the array equal to its maximum. For example, the array $$$[2, 3, 2, 4, 4, 3, 2]$$$ has $$$3$$$ elements equal to its minimum ($$$1$$$-st, $$$3$$$-rd and $$$7$$$-th) and $$$2$$$ elements equal to its maximum ($$$4$$$-th and $$$5$$$-th).Another example: the array $$$[42, 42, 42]$$$ has $$$3$$$ elements equal to its minimum and $$$3$$$ elements equal to its maximum.Your task is to calculate the minimum possible number of elements in a beautiful array.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. Each test case consists of one line containing four integers $$$l_1$$$, $$$r_1$$$, $$$l_2$$$ and $$$r_2$$$ ($$$1 \le l_1 \le r_1 \le 50$$$; $$$1 \le l_2 \le r_2 \le 50$$$).

For each test case, print one integer — the minimum possible number of elements in a beautiful array.

module Main (main)
where

import Data.List (intercalate, words)

main :: IO ()
main = intercalate "\n" <$> map show <$> map minElem <$> map readNums <$> (read <$> getLine >>= readNLines) >>= putStrLn

minElem :: (Int, Int, Int, Int) -> Int
minElem (a, b, c, d)
  | c `between` (a, b) = c
  | a `between` (c, d) = a
  | otherwise = a + c
  where x `between` (y, z) = x >= y && x <= z

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

readNums :: String -> (Int, Int, Int, Int)
readNums str = toQuadruple $ map read $ words str
  where toQuadruple [a, b, c, d] = (a, b, c, d)
        toQuadruple _ = undefined

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

intersectM :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
intersectM (l1, r1) (l2, r2) = if rr < ll then Nothing else Just (ll, rr)
    where
        ll = max l1 l2
        rr = min r1 r2

solve :: (Int, Int) -> (Int, Int) -> Int
solve (l1, r1) (l2, r2) =
        case mm of
            Nothing -> l1 + l2
            Just (ll, rr) -> ll
    where
        mm = intersectM (l1, r1) (l2, r2)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [l1, r1, l2, r2] <- B8.getLine <&> readIntB8s
        let answer = solve (l1, r1) (l2, r2)
        printf "%d\n" answer

import Control.Monad
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    [l1,r1,l2,r2] <- fmap (fmap read)
                   . fmap words
		   $ getLine :: IO [Int]
    print $ solve l1 r1 l2 r2

solve a1 b1 a2 b2
  | b1 < a2 || b2 < a1 = a1 + a2
  | otherwise = max a1 a2

module Main (main)
where

import Data.List (intercalate, words)

main :: IO ()
main = intercalate "\n" <$> map show <$> map minElem <$> map readNums <$> (read <$> getLine >>= readNLines) >>= putStrLn

minElem :: (Int, Int, Int, Int) -> Int
minElem (a, b, c, d)
  | c `between` (a, b) = c
  | a `between` (c, d) = a
  | otherwise = b + c
  where x `between` (y, z) = x >= y && x <= z

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

readNums :: String -> (Int, Int, Int, Int)
readNums str = toQuadruple $ map read $ words str
  where toQuadruple [a, b, c, d] = (a, b, c, d)
        toQuadruple _ = undefined


There is a new attraction in Singapore Zoo: The Infinite Zoo.The Infinite Zoo can be represented by a graph with an infinite number of vertices labeled $$$1,2,3,\ldots$$$. There is a directed edge from vertex $$$u$$$ to vertex $$$u+v$$$ if and only if $$$u\&v=v$$$, where $$$\&$$$ denotes the bitwise AND operation. There are no other edges in the graph.Zookeeper has $$$q$$$ queries. In the $$$i$$$-th query she will ask you if she can travel from vertex $$$u_i$$$ to vertex $$$v_i$$$ by going through directed edges.

The first line contains an integer $$$q$$$ ($$$1 \leq q \leq 10^5$$$) — the number of queries. The $$$i$$$-th of the next $$$q$$$ lines will contain two integers $$$u_i$$$, $$$v_i$$$ ($$$1 \leq u_i, v_i < 2^{30}$$$) — a query made by Zookeeper.

For the $$$i$$$-th of the $$$q$$$ queries, output "YES" in a single line if Zookeeper can travel from vertex $$$u_i$$$ to vertex $$$v_i$$$. Otherwise, output "NO". You can print your answer in any case. For example, if the answer is "YES", then the output "Yes" or "yeS" will also be considered as correct answer.

NoteThe subgraph on vertices $$$1,2,3,4,5,6$$$ is shown below.

-- import Debug.Trace

import Data.Bits

type InType  = (Int, Int)
type OutType = Bool

inpLines :: Int
inpLines = 1

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

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

solve :: InType -> OutType
solve (u, v)
    | u > v     = False
    | otherwise = go 0 0 0
    where go :: Int -> Int -> Int -> Bool
          go 31 _ _ = True
          go b o1 o2
            | o1 < o2 = False
            | otherwise = go (b + 1) (o1 + f b u) (o2 + f b v)
          f x b = if testBit b x then 1 else 0

receive :: [String] -> InType
receive [s] = (u, v)
    where [u, v] = toArr s

main :: IO ()
main = interact (unlines . map (showb . solve . receive) . chunksOf inpLines . tail . lines)
    where showb True = "YES"
          showb False = "NO"

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.Bits

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [q] <- readInts
  replicateM_ q $ do
    [u, v] <- readInts
    let
      fun i x = popCount $ x .&. (2 * bit i - 1)
      ok = v >= u && and [fun i v <= fun i u | i <- [0..29]]
    lift $ P.putStrLn $ if  ok
      then  P.pack "YES"
      else  P.pack "NO"

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


A bracketed sequence is called correct (regular) if by inserting "+" and "1" you can get a well-formed mathematical expression from it. For example, sequences "(())()", "()" and "(()(()))" are correct, while ")(", "(()" and "(()))(" are not.The teacher gave Dmitry's class a very strange task — she asked every student to come up with a sequence of arbitrary length, consisting only of opening and closing brackets. After that all the students took turns naming the sequences they had invented. When Dima's turn came, he suddenly realized that all his classmates got the correct bracketed sequence, and whether he got the correct bracketed sequence, he did not know.Dima suspects now that he simply missed the word "correct" in the task statement, so now he wants to save the situation by modifying his sequence slightly. More precisely, he can the arbitrary number of times (possibly zero) perform the reorder operation.The reorder operation consists of choosing an arbitrary consecutive subsegment (substring) of the sequence and then reordering all the characters in it in an arbitrary way. Such operation takes $$$l$$$ nanoseconds, where $$$l$$$ is the length of the subsegment being reordered. It's easy to see that reorder operation doesn't change the number of opening and closing brackets. For example for "))((" he can choose the substring ")(" and do reorder ")()(" (this operation will take $$$2$$$ nanoseconds).Since Dima will soon have to answer, he wants to make his sequence correct as fast as possible. Help him to do this, or determine that it's impossible.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^6$$$) — the length of Dima's sequence. The second line contains string of length $$$n$$$, consisting of characters "(" and ")" only.

Print a single integer — the minimum number of nanoseconds to make the sequence correct or "-1" if it is impossible to do so.

NoteIn the first example we can firstly reorder the segment from first to the fourth character, replacing it with "()()", the whole sequence will be "()()())(". And then reorder the segment from the seventh to eighth character, replacing it with "()". In the end the sequence will be "()()()()", while the total time spent is $$$4 + 2 = 6$$$ nanoseconds.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

main = do
  getLine
  str <- getLine
  if length (filter (== '(') str) /= length (filter (== ')') str)
    then print $ -1
    else print $ f 0 str

f _ [] = 0
f x ('(':cs) = f (x + 1) cs
f x (')':cs) = let x' = x - 1 in
  if x' < 0 then 1 + g x' cs
  else f x' cs

g _ [] = 0
g x ('(':cs) = let x' = x + 1 in
  if x' >= 0 then 1 + f x' cs
  else 1 + g x' cs
g x (')':cs) = 1 + g (x - 1) cs

f [] cnt ans
  | cnt /= 0 = -1
  | otherwise = ans
f (')':xs) cnt ans
  | cnt <= 0 = f xs (cnt-1) (ans+2)
  | otherwise = f xs (cnt-1) ans
f (_:xs) cnt ans = f xs (cnt+1) ans
main = do
  getLine
  s <- getLine
  print $ f s 0 0

f [] cnt ans = if cnt /= 0 then -1 else ans
f (')':xs) cnt ans = f xs (cnt-1) ans2
  where ans2 = if cnt > 0 then ans else ans+2
f (_:xs) cnt ans = f xs (cnt+1) ans
main = do
  getLine
  s <- getLine
  print $ f s 0 0

f [] cnt ans
  | cnt /= 0 = -1
  | otherwise = ans
f (')':xs) cnt ans = f xs (cnt-1) ans2
  where ans2 = if cnt > 0 then ans else ans+2
f (_:xs) cnt ans = f xs (cnt+1) ans
main = do
  getLine
  s <- getLine
  print $ f s 0 0


As Sherlock Holmes was investigating a crime, he identified n suspects. He knows for sure that exactly one of them committed the crime. To find out which one did it, the detective lines up the suspects and numbered them from 1 to n. After that, he asked each one: "Which one committed the crime?". Suspect number i answered either "The crime was committed by suspect number ai", or "Suspect number ai didn't commit the crime". Also, the suspect could say so about himself (ai = i).Sherlock Holmes understood for sure that exactly m answers were the truth and all other answers were a lie. Now help him understand this: which suspect lied and which one told the truth?

The first line contains two integers n and m (1 ≤ n ≤ 105, 0 ≤ m ≤ n) — the total number of suspects and the number of suspects who told the truth. Next n lines contain the suspects' answers. The i-th line contains either "+ai" (without the quotes), if the suspect number i says that the crime was committed by suspect number ai, or "-ai" (without the quotes), if the suspect number i says that the suspect number ai didn't commit the crime (ai is an integer, 1 ≤ ai ≤ n). It is guaranteed that at least one suspect exists, such that if he committed the crime, then exactly m people told the truth.

Print n lines. Line number i should contain "Truth" if suspect number i has told the truth for sure. Print "Lie" if the suspect number i lied for sure and print "Not defined" if he could lie and could tell the truth, too, depending on who committed the crime.

NoteThe first sample has the single person and he confesses to the crime, and Sherlock Holmes knows that one person is telling the truth. That means that this person is telling the truth.In the second sample there are three suspects and each one denies his guilt. Sherlock Holmes knows that only two of them are telling the truth. Any one of them can be the criminal, so we don't know for any of them, whether this person is telling the truth or not.In the third sample the second and the fourth suspect defend the first and the third one. But only one is telling the truth, thus, the first or the third one is the criminal. Both of them can be criminals, so the second and the fourth one can either be lying or telling the truth. The first and the third one are lying for sure as they are blaming the second and the fourth one.

import Data.Set
import Data.Array
q '+'=(1,0)
q '-'=(0,1)
z=fmap
c(a,b)(c,d)=(a+c,b+d)
s(h:l)=z e r where [n,m]=z read$words h;r=z(\(c:n)->(read n+0,q c))l;t=assocs$accumArray c(0,0)(1,n)r;s=fromList$z fst$Prelude.filter((==sum(z(fst.snd)t)-n+m).uncurry(-).snd)t;e(j,(k,n))|m&&size s>1="Not defined"|m==(k>n)="Truth"|1>0="Lie"where m=member j s
main=interact$unlines.s.lines

import qualified Data.Set as Set
import qualified Data.Array as Arr

s(h:t) = result ++ [] where
  [n,m] = map read $ words h
  rawTells = map tl t where
    tl ('+':n) = (read n :: Int, (1, 0))
    tl ('-':n) = (read n :: Int, (0, 1))
  cmb (a,b) (c,d) = (a+c, b+d)
  tells = Arr.assocs $ Arr.accumArray cmb (0,0) (1, n) $ rawTells
  liesByDefault = sum $ map (fst . snd) $ tells
  changeNeeded = liesByDefault-(n-m)
  suspects = map fst $ filter ((== changeNeeded).uncurry (-).snd) $ tells
  ss = Set.fromList suspects
  result = map eval rawTells where
    eval (j, _) | Set.member j ss && length suspects > 1 = "Not defined"
    eval (j, (k, nk)) | Set.member j ss == (k>nk) = "Truth"
     | otherwise = "Lie"

main=interact$unlines.s.lines

import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Arrow

s(h:t) = result ++ [] where
  [n,m] = map read $ words h
  rawTells = map tl t where
    tl ('+':n) = (read n :: Int, (1, 0))
    tl ('-':n) = (read n :: Int, (0, 1))
  cmb (a,b) (c,d) = (a+c, b+d)
  tells = Map.toList $ Map.fromListWith cmb $ rawTells
  liesByDefault = sum $ map (fst . snd) $ tells
  changeNeeded = liesByDefault-(n-m)
  suspects = map fst $ filter ((== changeNeeded).uncurry (-).snd) $ tells
  ss = Set.fromList suspects
  result = map eval rawTells where
    eval (j, _) | Set.member j ss && length suspects > 1 = "Not defined"
    eval (j, (k, nk)) | Set.member j ss == (k>nk) = "Truth"
     | otherwise = "Lie"

main=interact$unlines.s.lines


Note: The XOR-sum of set $$$\{s_1,s_2,\ldots,s_m\}$$$ is defined as $$$s_1 \oplus s_2 \oplus \ldots \oplus s_m$$$, where $$$\oplus$$$ denotes the bitwise XOR operation.After almost winning IOI, Victor bought himself an $$$n\times n$$$ grid containing integers in each cell. $$$n$$$ is an even integer. The integer in the cell in the $$$i$$$-th row and $$$j$$$-th column is $$$a_{i,j}$$$.Sadly, Mihai stole the grid from Victor and told him he would return it with only one condition: Victor has to tell Mihai the XOR-sum of all the integers in the whole grid.Victor doesn't remember all the elements of the grid, but he remembers some information about it: For each cell, Victor remembers the XOR-sum of all its neighboring cells.Two cells are considered neighbors if they share an edge — in other words, for some integers $$$1 \le i, j, k, l \le n$$$, the cell in the $$$i$$$-th row and $$$j$$$-th column is a neighbor of the cell in the $$$k$$$-th row and $$$l$$$-th column if $$$|i - k| = 1$$$ and $$$j = l$$$, or if $$$i = k$$$ and $$$|j - l| = 1$$$.To get his grid back, Victor is asking you for your help. Can you use the information Victor remembers to find the XOR-sum of the whole grid?It can be proven that the answer is unique.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single even integer $$$n$$$ ($$$2 \leq n \leq 1000$$$) — the size of the grid. Then follows $$$n$$$ lines, each containing $$$n$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th of these lines represents the XOR-sum of the integers in all the neighbors of the cell in the $$$i$$$-th row and $$$j$$$-th column. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$1000$$$ and in the original grid $$$0 \leq a_{i, j} \leq 2^{30} - 1$$$. Hack Format To hack a solution, use the following format: The first line should contain a single integer t ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case should contain a single even integer $$$n$$$ ($$$2 \leq n \leq 1000$$$) — the size of the grid. Then $$$n$$$ lines should follow, each containing $$$n$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th of these lines is $$$a_{i,j}$$$ in Victor's original grid. The values in the grid should be integers in the range $$$[0, 2^{30}-1]$$$ The sum of $$$n$$$ over all test cases must not exceed $$$1000$$$.

For each test case, output a single integer — the XOR-sum of the whole grid.

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    aLi <- replicateM (n * n) getInt
    let
      a :: UArray (Int, Int) Int
      a = listArray ((1, 1), (n, n)) aLi

      ok (i, j) = mod (i + j) 4 == 2 && if  i + j <= n + 1
        then  odd i
        else  even (n - j)

      ok2 (i, j) = ok (i, n + 1 - j)

      tot = foldl' xor 0 $ [v | (c, v) <- assocs a, ok c || ok2 c]

    pure $ putInts [tot]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    aLi <- replicateM (n * n) getInt
    let
      a :: UArray (Int, Int) Int
      a = listArray ((1, 1), (n, n)) aLi

      ok (i, j) = mod (i + j) 4 >= 2 && if  i + j <= n + 1
        then  odd i
        else  even (n - j)

      ok2 (i, j) = mod (i + j) 4 == 1 && (j == 1 || i == n)

      tot = foldl' xor 0 $ [v | (c, v) <- assocs a, ok c || ok2 c]

    pure $ putInts [tot]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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


Petya and Gena play a very interesting game "Put a Knight!" on a chessboard n × n in size. In this game they take turns to put chess pieces called "knights" on the board so that no two knights could threat each other. A knight located in square (r, c) can threat squares (r - 1, c + 2), (r - 1, c - 2), (r + 1, c + 2), (r + 1, c - 2), (r - 2, c + 1), (r - 2, c - 1), (r + 2, c + 1) and (r + 2, c - 1) (some of the squares may be located outside the chessboard). The player who can't put a new knight during his move loses. Determine which player wins considering that both players play optimally well and Petya starts.

The first line contains integer T (1 ≤ T ≤ 100) — the number of boards, for which you should determine the winning player. Next T lines contain T integers ni (1 ≤ ni ≤ 10000) — the sizes of the chessboards.

For each ni × ni board print on a single line "0" if Petya wins considering both players play optimally well. Otherwise, print "1".

main = readFile "input.txt" >>= writeFile "output.txt" . concat . map ((++"\n") . show . (`mod`2) . (+1) . read) . tail . lines

solve xs = map (\x -> if (x `mod` 2 == 0) then 1 else 0) xs

main = do text <- readFile "input.txt"
          writeFile "output.txt" (unlines $ map show $ solve $ map read $ tail $ lines text)

s x=show(mod(1+x)2)++"\n"
main=do{c<-readFile"input.txt";writeFile"output.txt"$foldl(++)""$map(s.read)$tail$words c}

s x=show(mod(1+x)2)++"\n"
main=do
 c<-readFile"input.txt"
 writeFile"output.txt"$foldl(++)""$map(s.read)$tail$words c


Morning desert sun horizonRise above the sands of time...Fates Warning, "Exodus"After crossing the Windswept Wastes, Ori has finally reached the Windtorn Ruins to find the Heart of the Forest! However, the ancient repository containing this priceless Willow light did not want to open!Ori was taken aback, but the Voice of the Forest explained to him that the cunning Gorleks had decided to add protection to the repository.The Gorleks were very fond of the "string expansion" operation. They were also very fond of increasing subsequences.Suppose a string $$$s_1s_2s_3 \ldots s_n$$$ is given. Then its "expansion" is defined as the sequence of strings $$$s_1$$$, $$$s_1 s_2$$$, ..., $$$s_1 s_2 \ldots s_n$$$, $$$s_2$$$, $$$s_2 s_3$$$, ..., $$$s_2 s_3 \ldots s_n$$$, $$$s_3$$$, $$$s_3 s_4$$$, ..., $$$s_{n-1} s_n$$$, $$$s_n$$$. For example, the "expansion" the string 'abcd' will be the following sequence of strings: 'a', 'ab', 'abc', 'abcd', 'b', 'bc', 'bcd', 'c', 'cd', 'd'. To open the ancient repository, Ori must find the size of the largest increasing subsequence of the "expansion" of the string $$$s$$$. Here, strings are compared lexicographically.Help Ori with this task!A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds: $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$; in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 10^3$$$), denoting the number of test cases. Description of the test cases follows. The first line of each test case contains one positive integer $$$n$$$ ($$$1 \le n \le 5000$$$) — length of the string. The second line of each test case contains a non-empty string of length $$$n$$$, which consists of lowercase latin letters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^4$$$.

For every test case print one non-negative integer — the answer to the problem.

7
5
acbac
8
acabacba
12
aaaaaaaaaaaa
10
abacabadac
8
dcbaabcd
3
cba
6
sparky

NoteIn first test case the "expansion" of the string is: 'a', 'ac', 'acb', 'acba', 'acbac', 'c', 'cb', 'cba', 'cbac', 'b', 'ba', 'bac', 'a', 'ac', 'c'. The answer can be, for example, 'a', 'ac', 'acb', 'acba', 'acbac', 'b', 'ba', 'bac', 'c'.

import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import qualified Data.ByteString.Char8 as C

type Arr = A.UArray Int Int

idx :: Int->Int->Int->Int
idx n i j = i*(n+1)+j

greater :: Int -> C.ByteString -> Arr -> Int -> Int -> Bool
greater n str lcp i j | (lcp ! (idx n i j)) == (n-i) = False
greater n str lcp i j | otherwise
  = let lcpScore = lcp ! (idx n i j)
    in
      (C.index str (i + lcpScore)) > (C.index str (j + lcpScore))

score :: Int -> C.ByteString -> Int -> Arr -> Int -> Int -> Int
score n str dpJ lcp i j =
  if greater n str lcp i j then
    dpJ + n - i - (lcp ! (idx n i j))
  else
    0

readInt :: C.ByteString -> Int
readInt bs = case C.readInt bs of
  Nothing -> error "Not an integer"
  Just (x, _) -> x

makeLcp :: Int -> C.ByteString -> Arr
makeLcp n str = runSTUArray $ do
  lcp <- newArray (0, (n+1)*(n+1)-1) 0
  forM_ [n-1,n-2..0] $ \i -> do
    forM_ [n-1,n-2..0] $ \j -> do
      if i==j then do
        writeArray lcp (idx n i j) (n-i)
      else if (C.index str i) /= (C.index str j) then do
        writeArray lcp (idx n i j) 0
      else do
        old <- (readArray lcp (idx n (i+1) (j+1)))
        writeArray lcp (idx n i j) (old + 1)
  return lcp

makeDp :: Int -> C.ByteString -> Arr -> Arr
makeDp n str lcp = runSTUArray $ do
  dp <- newArray (0, n-1) 0
  writeArray dp 0 n
  forM_ [1..n-1] $ \i -> do
    writeArray dp i (n-i)
    forM_ [0..i-1] $ \j -> do
      dpI <- readArray dp i
      dpJ <- readArray dp j
      let val = max dpI (score n str dpJ lcp i j)
      writeArray dp i val
  return dp

maxA :: Int -> Int -> Arr -> Int
maxA x (-1) _ = x
maxA x n dp =
  if (dp ! n) > x then
    maxA (dp ! n) (n-1) dp
  else
    maxA x (n-1) dp

calc :: Int -> C.ByteString -> Int
calc n str =
  let lcp = makeLcp n str
      dp = makeDp n str lcp
  in
    maxA n (n-1) dp

main = do
  line <- C.getLine
  let t = readInt line
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let len = readInt line
    str <- C.getLine
    let lcp = makeLcp len str
    let dp = makeDp len str lcp
--    forM_ [0..len] $ \i -> do
--      forM_ [0..len] $ \j -> do
--        putStr $ show (lcp ! (idx len i j))
--        putStr " "
--      putStrLn ""
    -- print lcp
--    print dp
    print $ calc len str