Phoenix has decided to become a scientist! He is currently investigating the growth of bacteria.Initially, on day $$$1$$$, there is one bacterium with mass $$$1$$$.Every day, some number of bacteria will split (possibly zero or all). When a bacterium of mass $$$m$$$ splits, it becomes two bacteria of mass $$$\frac{m}{2}$$$ each. For example, a bacterium of mass $$$3$$$ can split into two bacteria of mass $$$1.5$$$.Also, every night, the mass of every bacteria will increase by one.Phoenix is wondering if it is possible for the total mass of all the bacteria to be exactly $$$n$$$. If it is possible, he is interested in the way to obtain that mass using the minimum possible number of nights. Help him become the best scientist!

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$2 \le n \le 10^9$$$) — the sum of bacteria masses that Phoenix is interested in.

For each test case, if there is no way for the bacteria to exactly achieve total mass $$$n$$$, print -1. Otherwise, print two lines. The first line should contain an integer $$$d$$$  — the minimum number of nights needed. The next line should contain $$$d$$$ integers, with the $$$i$$$-th integer representing the number of bacteria that should split on the $$$i$$$-th day. If there are multiple solutions, print any.

NoteIn the first test case, the following process results in bacteria with total mass $$$9$$$:   Day $$$1$$$: The bacterium with mass $$$1$$$ splits. There are now two bacteria with mass $$$0.5$$$ each.  Night $$$1$$$: All bacteria's mass increases by one. There are now two bacteria with mass $$$1.5$$$.  Day $$$2$$$: None split.  Night $$$2$$$: There are now two bacteria with mass $$$2.5$$$.  Day $$$3$$$: Both bacteria split. There are now four bacteria with mass $$$1.25$$$.  Night $$$3$$$: There are now four bacteria with mass $$$2.25$$$.  The total mass is $$$2.25+2.25+2.25+2.25=9$$$. It can be proved that $$$3$$$ is the minimum number of nights needed. There are also other ways to obtain total mass 9 in 3 nights.$$$ $$$In the second test case, the following process results in bacteria with total mass $$$11$$$:   Day $$$1$$$: The bacterium with mass $$$1$$$ splits. There are now two bacteria with mass $$$0.5$$$.  Night $$$1$$$: There are now two bacteria with mass $$$1.5$$$.  Day $$$2$$$: One bacterium splits. There are now three bacteria with masses $$$0.75$$$, $$$0.75$$$, and $$$1.5$$$.  Night $$$2$$$: There are now three bacteria with masses $$$1.75$$$, $$$1.75$$$, and $$$2.5$$$.  Day $$$3$$$: The bacteria with mass $$$1.75$$$ and the bacteria with mass $$$2.5$$$ split. There are now five bacteria with masses $$$0.875$$$, $$$0.875$$$, $$$1.25$$$, $$$1.25$$$, and $$$1.75$$$.  Night $$$3$$$: There are now five bacteria with masses $$$1.875$$$, $$$1.875$$$, $$$2.25$$$, $$$2.25$$$, and $$$2.75$$$.  The total mass is $$$1.875+1.875+2.25+2.25+2.75=11$$$. It can be proved that $$$3$$$ is the minimum number of nights needed. There are also other ways to obtain total mass 11 in 3 nights.$$$ $$$In the third test case, the bacterium does not split on day $$$1$$$, and then grows to mass $$$2$$$ during night $$$1$$$.

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

main = getLine >>= flip replicateM_ test . read

test = do
    n <- read <$> getLine
    let ds = zipWith subtract <*> tail $ solve n
    print $ length ds
    putStrLn $ unwords . map show $ ds

solve n = sort $ f 1 n

f _ 0 = []
f i n
    | i > n = [n]
    | otherwise = i : f (2 * i) (n - i)

powersOf2 :: [Int]
powersOf2 = go 1
    where
        go aux = aux : go (aux*2)

diff :: Int -> [Int] -> [Int]
diff excess (a:as)
    | excess <= a   = [excess]
    | otherwise     = a: diff (excess-a) as

numberOfDays :: Int -> (Int, Int)
numberOfDays n = (d, n-2^d)
    where
        d = floor . logBase 2 . fromIntegral $ n

increments :: [Int] -> [Int]
increments (a1:a2:as) = (a2-a1): increments (a2:as)
increments _ = []

solve :: Int -> [String]
solve n = [show d, unwords $ map show inc]
    where
        (d,e) = numberOfDays n
        delta = diff e powersOf2 ++ [0,0..]
        count = 1 : take d (zipWith (+) delta powersOf2)
        inc = increments count

test = solve 9

main :: IO ()
main = interact $ unlines . concatMap (solve . read) . tail . lines


In the town of Aalam-Aara (meaning the Light of the Earth), previously there was no crime, no criminals but as the time progressed, sins started creeping into the hearts of once righteous people. Seeking solution to the problem, some of the elders found that as long as the corrupted part of population was kept away from the uncorrupted part, the crimes could be stopped. So, they are trying to set up a compound where they can keep the corrupted people. To ensure that the criminals don't escape the compound, a watchtower needs to be set up, so that they can be watched.Since the people of Aalam-Aara aren't very rich, they met up with a merchant from some rich town who agreed to sell them a land-plot which has already a straight line fence AB along which a few points are set up where they can put up a watchtower. Your task is to help them find out the number of points on that fence where the tower can be put up, so that all the criminals can be watched from there. Only one watchtower can be set up. A criminal is watchable from the watchtower if the line of visibility from the watchtower to him doesn't cross the plot-edges at any point between him and the tower i.e. as shown in figure 1 below, points X, Y, C and A are visible from point B but the points E and D are not.    Figure 1     Figure 2 Assume that the land plot is in the shape of a polygon and coordinate axes have been setup such that the fence AB is parallel to x-axis and the points where the watchtower can be set up are the integer points on the line. For example, in given figure 2, watchtower can be setup on any of five integer points on AB i.e. (4, 8), (5, 8), (6, 8), (7, 8) or (8, 8). You can assume that no three consecutive points are collinear and all the corner points other than A and B, lie towards same side of fence AB. The given polygon doesn't contain self-intersections.

The first line of the test case will consist of the number of vertices n (3 ≤ n ≤ 1000). Next n lines will contain the coordinates of the vertices in the clockwise order of the polygon. On the i-th line are integers xi and yi (0 ≤ xi, yi ≤ 106) separated by a space. The endpoints of the fence AB are the first two points, (x1, y1) and (x2, y2).

Output consists of a single line containing the number of points where the watchtower can be set up.

NoteFigure 2 shows the first test case. All the points in the figure are watchable from any point on fence AB. Since, AB has 5 integer coordinates, so answer is 5.For case two, fence CD and DE are not completely visible, thus answer is 0.

module Main where

readI :: String -> Int
readI = read

readL :: String -> [Double]
readL = (map read) . words

main = do
    n <- getLine >>= return . readI
    ps <- getContents >>= return . (map readL) . (take n) . lines
    print $ solve n ps

solve n ps = inter pairs y0 l r where

    pairs = tail (zip ps (tail ps ++ [head ps]))

    a = head ps
    b = ps!!1
    l = min (head a) (head b)
    r = max (head a) (head b)
    y0 = a!!1

    inter _   _ l r |  l > r  = 0
    inter []  _ l r           = (floor r) - (ceiling l) + 1

    inter (([x1,y1], [x2,y2]):ps) y0 l r = case compare dy 0 of
        EQ -> if dx0 <= 0 then inter ps y0 l r
                          else 0
        GT -> inter ps y0 (max l x0) r
        LT -> inter ps y0 l (min x0 r)
        where
            dy = y2 - y1
            dx = x2 - x1
            c = dx*y1 - dy*x1
            dx0 = dx*y0 - c
            x0 = dx0 / dy

module Main where

readI :: String -> Int
readI = read

readL :: String -> [Double]
readL = (map read) . words

main = do
    n <- getLine >>= return . readI
    ps <- getContents >>= return . (map readL) . (take n) . lines
    print $ solve n ps

solve n ps = inter pairs y0 l r where

    pairs = tail (zip ps (tail ps ++ [head ps]))

    a = head ps
    b = ps!!1
    l = min (head a) (head b)
    r = max (head a) (head b)
    y0 = a!!1

    inter []  _ l r = if l > r then 0 else (floor r) - (ceiling l) + 1

    inter (([x1,y1], [x2,y2]):ps) y0 l r = case compare dy 0 of
        EQ -> if dx0 <= 0 then inter ps y0 l r
                          else 0
        GT -> inter ps y0 (max l x0) r
        LT -> inter ps y0 l (min x0 r)
        where
            dy = y2 - y1
            dx = x2 - x1
            c = dx*y1 - dy*x1
            dx0 = dx*y0 - c
            x0 = dx0 / dy


Polycarp loves geometric progressions — he collects them. However, as such progressions occur very rarely, he also loves the sequences of numbers where it is enough to delete a single element to get a geometric progression.In this task we shall define geometric progressions as finite sequences of numbers a1, a2, ..., ak, where ai = c·bi - 1 for some real numbers c and b. For example, the sequences [2, -4, 8], [0, 0, 0, 0], [199] are geometric progressions and [0, 1, 2, 3] is not.Recently Polycarp has found a sequence and he can't classify it. Help him to do it. Determine whether it is a geometric progression. If it is not, check if it can become a geometric progression if an element is deleted from it.

The first line contains an integer n (1 ≤ n ≤ 105) — the number of elements in the given sequence. The second line contains the given sequence. The numbers are space-separated. All the elements of the given sequence are integers and their absolute value does not exceed 104.

Print 0, if the given sequence is a geometric progression. Otherwise, check if it is possible to make the sequence a geometric progression by deleting a single element. If it is possible, print 1. If it is impossible, print 2.

main = do getLine; getLine >>= putStr . show . gao . map (fromInteger . read) . words
gao [0, 0] = 0
gao [0, _] = 1
gao x = if length x < 3 then 0 else minimum $ 2:[f i (if j == 0 then 0 else j / i) x | (i, j) <- [(b, c), (a, c), (a, b)], j == 0 || i /= 0] where
	(a:b:c:_) = x
	f _ _ [] = 0
	f a b (h:t) = if a == h then f (a*b) b t else f a b t + 1

main = do getLine; getLine >>= putStr . show . gao . map read . words
gao x = if length x < 3 then 0 else minimum $ 2:[f j (div i j) x | (i, j) <- [(c, b), (c, a), (b, a)], j /= 0, mod i j == 0] where
	(a:b:c:_) = x
	f _ _ [] = 0
	f a b (h:t) = if a == h then f (a*b) b t else f a b t + 1

main = do getLine; getLine >>= putStr . show . gao . map read . words
gao [0, 0] = 0
gao [0, _] = 1
gao x = if length x < 3 then 0 else minimum $ 2:[f i (if j == 0 then 0 else div j i) x | (i, j) <- [(b, c), (a, c), (a, b)], j == 0 || i /= 0 && mod j i == 0] where
	(a:b:c:_) = x
	f _ _ [] = 0
	f a b (h:t) = if a == h then f (a*b) b t else f a b t + 1

main = do getLine; getLine >>= putStr . show . gao . map read . words
gao x = if length x < 3 then 0 else minimum $ 2:[f i (if j == 0 then 0 else div j i) x | (i, j) <- [(b, c), (a, c), (a, b)], i /= 0 && mod j i == 0 || j == 0] where
	(a:b:c:_) = x
	f _ _ [] = 0
	f a b (h:t) = if a == h then f (a*b) b t else f a b t + 1


The Hedgehog recently remembered one of his favorite childhood activities, — solving puzzles, and got into it with new vigor. He would sit day in, day out with his friend buried into thousands of tiny pieces of the picture, looking for the required items one by one.Soon the Hedgehog came up with a brilliant idea: instead of buying ready-made puzzles, one can take his own large piece of paper with some picture and cut it into many small rectangular pieces, then mix them and solve the resulting puzzle, trying to piece together the picture. The resulting task is even more challenging than the classic puzzle: now all the fragments have the same rectangular shape, and one can assemble the puzzle only relying on the picture drawn on the pieces.All puzzle pieces turn out to be of the same size X × Y, because the picture is cut first by horizontal cuts with the pitch of X, then with vertical cuts with the pitch of Y. If we denote the initial size of the picture as A × B, then A must be divisible by X and B must be divisible by Y (X and Y are integer numbers). However, not every such cutting of the picture will result in a good puzzle. The Hedgehog finds a puzzle good if no two pieces in it are the same (It is allowed to rotate the pieces when comparing them, but it is forbidden to turn them over). Your task is to count for a given picture the number of good puzzles that you can make from it, and also to find the puzzle with the minimal piece size.

The first line contains two numbers A and B which are the sizes of the picture. They are positive integers not exceeding 20. Then follow A lines containing B symbols each, describing the actual picture. The lines only contain uppercase English letters.

In the first line print the number of possible good puzzles (in other words, the number of pairs (X, Y) such that the puzzle with the corresponding element sizes will be good). This number should always be positive, because the whole picture is a good puzzle itself.  In the second line print two numbers — the sizes X and Y of the smallest possible element among all good puzzles. The comparison is made firstly by the area XY of one element and secondly — by the length X.

NoteThe picture in the first sample test has the following good puzzles: (2, 1), (2, 2), (2, 4).

import Control.Monad
import Data.List

explode' i x = take i . map (take x) . iterate (drop x)
explode :: Int -> Int -> Int -> Int -> [String] -> [[String]]
explode i x j y = concatMap (map (map head) . take j . iterate (map tail)) . explode' i x . map (explode' j y)
rotate = reverse . transpose
std = minimum . take 4 . iterate rotate

gao r c s = [[x * y, x, y] |
	x <- [1 .. r], i <- [div r x], i * x == r,
	y <- [1 .. c], j <- [div c y], j * y == c,
	(==i*j) $ length $ group $ sort $ map std $ explode i x j y s]

main = do
	[r, c] <- fmap (map read . words) getLine
	s <- replicateM r getLine
	putStrLn $ let a = gao r c s in unwords $ map show $ (length a:) $ tail $ minimum a

import Control.Monad
import Data.List

explode' i x = take i . map (take x) . iterate (drop x)
explode i x j y = concatMap (map (map head) . take j . iterate (map tail)) . explode' i x . map (explode' j y)
rotate = reverse . transpose
std = minimum . take 4 . iterate rotate

gao r c s = [[x * y, x, y] |
	x <- [1 .. r], i <- [div r x], i * x == r,
	y <- [1 .. c], j <- [div c y], j * y == c,
	(==i*j) $ length $ group $ sort $ map std $ explode i x j y s]

main = do
	[r, c] <- fmap (map read . words) getLine
	s <- replicateM r getLine
	putStrLn $ let a = gao r c s in unwords $ map show $ (length a:) $ tail $ minimum a

module Main (main) where

import Data.List

readInt :: String -> Int
readInt = read

main = do
    input <- getLine
    let [a, b] = map readInt $ take 2 $ words input
    input <- getContents
    let picture = take a $ lines input
    let good = goodPuzzles a b picture
    print $ length good
    printPair $ minimumBy compareXY good where

    goodPuzzles a b picture = filter isGoodPuzzle pairs where

        isGoodPuzzle (n, m) = isGood $ sort $ makeSprites n m where
            isGood [s]    = True
            isGood (s:ss) = if s == (head ss) then False else isGood ss

        makeSprites n m = makeSplitList a b picture [] where
            makeSplitList 0  _  _   acc = acc
            makeSplitList sn sm pic acc =
                makeSplitList (sn-n) sm (drop n pic)
                              (makeSplit sm (take n pic) [] ++ acc)
            makeSplit 0  _   acc = acc
            makeSplit sm pic acc =
                makeSplit (sm-m) (map (drop m) pic)
                                 (map concat (rotates n m (map (take m) pic)) ++ acc)
            rotates n m pic = if n == m
                then nub [pic, rot90, rot180, rot270]
                else nub [pic, rot180] where
                    rot90 = transpose reversed
                    rot180 = map reverse reversed
                    rot270 = reverse (transpose pic)
                    reversed = reverse pic

        pairs = [(x, y) | x <- divisors a, y <- divisors b]
        divisors n = [x | x <- [1..n], mod n x == 0]

    compareXY (x1, y1) (x2, y2) = case compare (x1*y1) (x2*y2) of
        LT -> LT
        GT -> GT
        EQ -> compare x1 x2

    printPair (x, y) = do
        putStrLn $ show x ++ " " ++ show y

{-# LANGUAGE ViewPatterns #-}

import Data.Array.IArray
import Data.List
import Text.Printf
import Debug.Trace

type Block = Array (Int, Int) Char

size :: Block -> (Int, Int)
size blk =
    let (_, (h, w)) = bounds blk
    in (h+1,w+1)

rotate :: Block -> Block
rotate blk =
    let (size -> (h, w)) = blk
    in listArray ((0,0), (w-1,h-1))
                 [blk ! (c, w-r-1) | r <- [0..w-1], c <- [0..h-1]]

minrep :: Block -> Block
minrep blk = minimum $ take 4 $ iterate rotate blk

valid :: [Block] -> Bool
valid list =
    let sorted = sort $ map minrep list
    in and $ zipWith (/=) sorted (tail sorted)

split :: Block -> Int -> Int -> [Block]
split blk a b =
    let (size -> (h, w)) = blk
    in [listArray ((0,0), (a-1,b-1))
                  [blk ! (h'*a+a', w'*b+b') | a' <- [0..a-1], b' <- [0..b-1]]
        | h' <- [0..h `div` a - 1], w' <- [0..w `div` b - 1]]

solve :: Block -> [[Block]]
solve blk =
    let (size -> (h, w)) = blk
        divable x y = x `mod` y == 0
        allblk = [split blk a b | a <- filter (divable h) [1..h],
                                  b <- filter (divable w) [1..w]]
    in filter valid allblk

cmp :: [Block] -> [Block] -> Ordering
cmp (a:_) (b:_) =
    let (size -> (ha, wa)) = a
        (size -> (hb, wb)) = b
    in case compare (ha * wa) (hb * wb) of
         EQ -> compare ha hb
         ne -> ne

readBlk :: Int -> Int -> IO Block
readBlk w h = do
    list <- (concat . words) `fmap` getContents
    return $ listArray ((0,0), (w-1,h-1)) list

main = do
    [w, h] <- (map read . words) `fmap` getLine
    blk <- readBlk w h

    let ans = solve blk
    printf "%d\n" (length ans)

    let (size -> (x, y)) = head $ minimumBy cmp ans
    printf "%d %d\n" x y

module Main (main) where

import Data.List

readInt :: String -> Int
readInt = read

main = do
    input <- getLine
    let [a, b] = map readInt $ take 2 $ words input
    input <- getContents
    let picture = take a $ lines input
    let good = goodPuzzles a b picture
    print $ length good
    printPair $ minimumBy compareXY good where

    goodPuzzles a b picture = filter isGoodPuzzle pairs where

        isGoodPuzzle (n, m) = isGood $ sort $ makeSprites n m where
            isGood [s]    = True
            isGood (s:ss) = if s == (head ss) then False else isGood ss

        makeSprites n m = makeSplitList a b picture [] where
            makeSplitList 0  _  _   acc = acc
            makeSplitList sn sm pic acc =
                makeSplitList (sn-n) sm (drop n pic)
                              (acc ++ makeSplit sm (take n pic) [])
            makeSplit 0  _   acc = acc
            makeSplit sm pic acc =
                makeSplit (sm-m) (map (drop m) pic)
                                 ((concat (map (take m) pic)):acc)

        pairs = [(x, y) | x <- divisors a, y <- divisors b]
        divisors n = [x | x <- [1..n], mod n x == 0]

    compareXY (x1, y1) (x2, y2) = case compare (x1*y1) (x2*y2) of
        LT -> LT
        GT -> GT
        EQ -> compare x1 x2

    printPair (x, y) = do
        putStrLn $ show x ++ " " ++ show y


A frog is currently at the point $$$0$$$ on a coordinate axis $$$Ox$$$. It jumps by the following algorithm: the first jump is $$$a$$$ units to the right, the second jump is $$$b$$$ units to the left, the third jump is $$$a$$$ units to the right, the fourth jump is $$$b$$$ units to the left, and so on.Formally:   if the frog has jumped an even number of times (before the current jump), it jumps from its current position $$$x$$$ to position $$$x+a$$$;  otherwise it jumps from its current position $$$x$$$ to position $$$x-b$$$. Your task is to calculate the position of the frog after $$$k$$$ jumps.But... One more thing. You are watching $$$t$$$ different frogs so you have to answer $$$t$$$ independent queries.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of queries. Each of the next $$$t$$$ lines contain queries (one query per line). The query is described as three space-separated integers $$$a, b, k$$$ ($$$1 \le a, b, k \le 10^9$$$) — the lengths of two types of jumps and the number of jumps, respectively.

Print $$$t$$$ integers. The $$$i$$$-th integer should be the answer for the $$$i$$$-th query.

NoteIn the first query frog jumps $$$5$$$ to the right, $$$2$$$ to the left and $$$5$$$ to the right so the answer is $$$5 - 2 + 5 = 8$$$.In the second query frog jumps $$$100$$$ to the right, $$$1$$$ to the left, $$$100$$$ to the right and $$$1$$$ to the left so the answer is $$$100 - 1 + 100 - 1 = 198$$$.In the third query the answer is $$$1 - 10 + 1 - 10 + 1 = -17$$$.In the fourth query the answer is $$$10^9 - 1 + 10^9 - 1 + 10^9 - 1 = 2999999997$$$.In the fifth query all frog's jumps are neutralized by each other so the answer is $$$0$$$.The sixth query is the same as the fifth but without the last jump so the answer is $$$1$$$.

{-# LANGUAGE ScopedTypeVariables #-}

import           Data.Int

main :: IO ()
main = readLn >>= ntimes solve

ntimes :: IO () -> Int -> IO ()
ntimes _  0 = return ()
ntimes io n = io >> ntimes io (n - 1)

solve :: IO ()
solve = do
    [a, b, k] :: [Int64] <- map read . words <$> getLine
    let ans = k `div` 2 * (a - b)
    if k `mod` 2 /= 0 then print $ ans + a else print ans

{-# LANGUAGE NPlusKPatterns #-}
module Main (main) where

import Control.Monad (liftM2, liftM3, mapM_)

type Query = (Integer, Integer, Integer)

main :: IO ()
main = do
    t <- getInteger
    queries <- getQueries t
    mapM_ (print . calculate) queries

getInteger :: IO Integer
getInteger = fmap read getLine

getQueries :: Integer -> IO [Query]
getQueries 0 = return []
getQueries (n + 1) = liftM2 (:) getQuery (getQueries n)

getQuery :: IO Query
getQuery = fmap ((\[a, b, k] -> (a, b, k)) . map read . words) getLine

calculate :: Query -> Integer
calculate (a, b, k) = let (q, r) = quotRem k 2
                      in q * (a - b) + r * a

main :: IO ()
main = interact $ processInput.parseInput

readInteger :: String -> Integer
readInteger = read

parseInput :: String -> [[Integer]]
parseInput inputFromFile = tail [[readInteger x | x <- words line] | line <- lines inputFromFile]

calcFunc :: Integer -> Integer -> Integer -> Integer
calcFunc a b k
  | odd k = (a-b)*((k-1)`div` 2) + a
  | otherwise = (a - b)*(k`div` 2)

processInput :: [[Integer]] -> String
processInput [] = ""
processInput (x:xs) = (show $ calcFunc (x !! 0) (x !! 1) (x !! 2))++ "\n" ++ processInput xs

solve :: [Integer] -> Integer
solve (a:b:k:_) = (a - b) * (k `div` 2) + a * (k `mod` 2)

main :: IO()
main = do
  n <- getLine
  x <- getContents
  mapM_ (putStrLn . show . solve . (map (read::String->Integer)) . words) $ lines x

readInteger :: String -> Integer
readInteger = read

parseInput :: String -> [[Integer]]
parseInput file
    = tail [ [readInteger word | word <- words line] | line <- lines file ]

processInput :: [[Integer]] -> [Integer]
processInput [] = []
processInput ([right, left, steps] : others)
    = pos : (processInput others)
      where pos = if even steps then total else total + right
            total = (right - left) * (steps `div` 2)

showOutput :: [Integer] -> String
showOutput [] = ""
showOutput (x:xs) = (show x) ++ "\n" ++ (showOutput xs)

main = interact $ showOutput . processInput . parseInput

getFrogs :: Int -> IO [[Integer]]
getFrogs 0 = do return []
getFrogs t = do
    line <- getLine
    let xs = map (\s -> read s :: Integer) (words line)
    more <- getFrogs (t - 1)
    return (xs : more)

main = do
    line <- getLine
    let n = read line :: Int
    frogs <- getFrogs n
    mapM print (positions frogs)

positions :: [[Integer]] -> [Integer]
positions [] = []
positions ([right, left, steps] : frogs)
    = pos : (positions frogs)
      where pos = if even steps then total else total + right
            total = (right - left) * (steps `div` 2)

f::[String]->[Integer]
f []=[]
f (x:xs)=let (a:b:k:[])=map read (words x)::[Integer]
         in if k `mod` 2==1 then ((a-b)*(k `div` 2)+a):(f xs) else (a-b)*(k `div` 2):f xs

main = do
       a<-getLine
       b<-getContents
       let xs=lines b
       mapM_ putStrLn $ map show $  f xs

import Control.Monad
import Data.Bits

main = getLine
   >>= readQueries . read
   >>= putStrLn . calc

readQueries :: Int -> IO [String]
readQueries t = mapM (\_ -> getLine) [1..t]

calc :: [String] -> String
calc lines = foldr go "" lines
  where go line ans = show res ++ "\n" ++ ans
          where [s1, s2, s3] = words line
                a = read s1
                b = read s2
                k = read s3
                halfK = div k 2
                res = ((.&.) k 1 + halfK) * a - (b * halfK) :: Integer

import Prelude
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor

solve :: Int64 -> Int64 -> Int64 -> Int64
solve a b k = k1 * a - k2 * b
    where
        k1 = k - k2
        k2 = k `div` 2

main :: IO ()
main = do
    t <- (read :: String -> Int) <$> getLine
    replicateM_ t $ do
        [a, b, k] <- (map (read :: String -> Int64) . words) <$> getLine
        printf "%lld\n" $ solve a b k

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 :: [Integer] -> Integer
solve [a, b, k]
    | even k    = (a - b) * c
    | otherwise = (a - b) * c + a
        where c = div k 2

main :: IO ()
main = do
    t <- readInt
    qs <- replicateM t $ readInts
    mapM_ print $ map solve $ map (map toInteger) qs

import Data.Int
import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [a,b,k] <- map read . words <$> getLine
    print ((k+1) `div` 2 * a - k `div` 2 * b :: Int64)

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

onecase = do
		[a,b,k]<- map read <$> words <$> getLine ::IO [Integer]
		print $ (a-b)*(div k 2) + a *(mod k 2)

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

--ghc 7.10

finalPosition a b k = kOdd * a - kEven * b
    where
        kEven = k `div` 2
        kOdd = k - kEven

main = do
    nStr <- getLine
    contents <- getContents
    let qs = map (map read . words) . lines $ contents :: [[Integer]]
    sequence . map print . map (\[a,b,k] -> finalPosition a b k) $ qs

module Main where

import Control.Monad

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

getList :: IO [Integer]
getList = (map read) <$> words <$> getLine

solve :: [Integer] -> Integer
solve ins =
    let a = ins !! 0
        b = ins !! 1
        k = ins !! 2
        c = k `div` 2
    in ((-1) * b * c) + (k - c) * a

main :: IO ()
main = do
    t <- getInt
    replicateM_ t $ do ins <- getList
                       print $ solve ins

getFrogs :: Int -> IO [[Int]]
getFrogs 0 = do return []
getFrogs t = do
    line <- getLine
    let xs = map (\s -> read s :: Int) (words line)
    more <- getFrogs (t - 1)
    return (xs : more)

main = do
    line <- getLine
    let n = read line :: Int
    frogs <- getFrogs n
    mapM print (positions frogs)

positions :: [[Int]] -> [Int]
positions [] = []
positions ([right, left, steps] : frogs)
    = pos : (positions frogs)
      where pos = if even steps then total else total + right
            total = (right - left) * (steps `div` 2)

import Control.Monad
import Data.Bits

main = getLine
   >>= readQueries . read
   >>= putStrLn . calc

readQueries :: Int -> IO [String]
readQueries t = mapM (\_ -> getLine) [1..t]

calc :: [String] -> String
calc lines = foldr go "" lines
  where go line ans = show res ++ "\n" ++ ans
          where [s1, s2, s3] = words line
                a = read s1
                b = read s2
                k = read s3
                halfK = div k 2
                res = (.&.) k 1 + halfK * a - (b * halfK) :: Integer

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 :: [Int] -> Int
solve [a, b, k]
    | even k    = (a - b) * c
    | otherwise = (a * (c + 1)) - b * c
        where c = div k 2

main :: IO ()
main = do
    t <- readInt
    qs <- replicateM t $ readInts
    mapM_ print $ map solve qs

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 :: [Int] -> Int
solve [a, b, k]
    | even k    = (a - b) * c
    | otherwise = (a - b) * c + a
        where c = div k 2

main :: IO ()
main = do
    t <- readInt
    qs <- replicateM t $ readInts
    mapM_ print $ map solve qs

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

onecase = do
		[a,b,k]<- map read <$> words <$> getLine ::IO [Int]
		print $ (a-b)*(div k 2) + a *(mod k 2)

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

--ghc 7.10

finalPosition a b k = kOdd * a - kEven * b
    where
        kEven = k `div` 2
        kOdd = k - kEven

main = do
    nStr <- getLine
    contents <- getContents
    let qs = map (map read . words) . lines $ contents :: [[Int]]
    sequence . map print . map (\[a,b,k] -> finalPosition a b k) $ qs

--ghc 7.10

finalPosition :: (Integral a) => a -> a -> a -> a
finalPosition a b k = kOdd * a - kEven * b
    where
        kEven = k `div` 2
        kOdd = k - kEven

main = do
    nStr <- getLine
    contents <- getContents
    let qs = map (map read . words) . lines $ contents :: [[Int]]
    sequence . map print . map (\[a,b,k] -> finalPosition a b k) $ qs


A string is binary, if it consists only of characters "0" and "1".String v is a substring of string w if it has a non-zero length and can be read starting from some position in string w. For example, string "010" has six substrings: "0", "1", "0", "01", "10", "010". Two substrings are considered different if their positions of occurrence are different. So, if some string occurs multiple times, we should consider it the number of times it occurs.You are given a binary string s. Your task is to find the number of its substrings, containing exactly k characters "1".

The first line contains the single integer k (0 ≤ k ≤ 106). The second line contains a non-empty binary string s. The length of s does not exceed 106 characters.

Print the single number — the number of substrings of the given string, containing exactly k characters "1". Please do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteIn the first sample the sought substrings are: "1", "1", "10", "01", "10", "010".In the second sample the sought substrings are: "101", "0101", "1010", "01010".

import Data.Int

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

solve k s
	| k == 0 = sum $ map (\c -> c*(c-1) `div` 2) cs
	| otherwise = sum $ zipWith (*) (drop k cs) cs
	where
		cs = map fromIntegral . map ((+ 1) . length) $ split '1' s

main = do
	k <- readLn
	s <- getLine
	print (solve k s)

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Debug.Trace
import qualified Data.ByteString.Char8 as B

solve :: Int -> B.ByteString -> Int64
solve k s
    | k == 0 = sum . map l2 . filter ((=='0') . B.head) $ B.group s
    | B.count '1' s < k = 0
    | otherwise = fst $ B.foldl' f (0, (kth, 1 + zeros kth s)) s
  where n = B.length s
        kth = (B.findIndices (== '1') s) !! (k-1)
        f (!a, (!j, !c)) d
            | d == '0' = (na, (j, c))
            | d == '1' = if j+c < n
                then (na, (j+c, 1 + zeros (j+c) s))
                else (na, (n, 0))
          where na = a + fromIntegral c

zeros :: Int -> B.ByteString -> Int
zeros i = B.length . B.takeWhile (== '0') . B.drop (i+1)

l2 :: B.ByteString -> Int64
l2 s = let l = fromIntegral $ B.length s in (l * (l+1)) `div` 2

main = do
    [k', s] <- B.words <$> B.getContents
    let k = read . B.unpack $ k'
    putStrLn . show $ solve k s

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Debug.Trace
import qualified Data.ByteString.Char8 as B

solve :: Int -> B.ByteString -> Integer
solve k s
    | k == 0 = sum . map l2 . filter ((=='0') . B.head) $ B.group s
    | B.count '1' s < k = 0
    | otherwise = fst $ B.foldl' f (0, (kth, 1 + zeros kth s)) s
  where n = B.length s
        kth = (B.findIndices (== '1') s) !! (k-1)
        f (!a, (!j, !c)) d
            | d == '0' = (na, (j, c))
            | d == '1' = if j+c < n
                then (na, (j+c, 1 + zeros (j+c) s))
                else (na, (n, 0))
          where na = a + fromIntegral c

zeros :: Int -> B.ByteString -> Int
zeros i = B.length . B.takeWhile (== '0') . B.drop (i+1)

l2 :: B.ByteString -> Integer
l2 s = (l * (l+1)) `div` 2
  where l = fromIntegral $ B.length s

main = do
    [k', s] <- B.words <$> B.getContents
    let k = read . B.unpack $ k'
    putStrLn . show $ solve k s

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Debug.Trace
import qualified Data.ByteString.Char8 as B

solve :: Int -> B.ByteString -> Int64
solve k s
    | k == 0 = sum . map l2 . filter ((=='0') . B.head) $ B.group s
    | B.count '1' s < k = 0
    | otherwise = fst $ B.foldl' f (0, (kth, 1 + zeros kth s)) s
  where n = B.length s
        kth = (B.findIndices (== '1') s) !! (k-1)
        f (!a, (!j, !c)) d
            | d == '0' = (na, (j, c))
            | d == '1' = if j+c < n
                then (na, (j+c, 1 + zeros (j+c) s))
                else (na, (n, 0))
          where na = a + fromIntegral c

zeros :: Int -> B.ByteString -> Int
zeros i = B.length . B.takeWhile (== '0') . B.drop (i+1)

l2 :: B.ByteString -> Int64
l2 s = (l * (l+1)) `div` 2
  where l = fromIntegral $ B.length s

main = do
    k <- read . B.unpack <$> B.getLine
    s <- head . B.words <$> B.getLine
--    [k', s] <- B.words <$> B.getContents
--    let k = read . B.unpack $ k'
    putStrLn . show $ solve k s

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Data.Int
import Debug.Trace
import qualified Data.ByteString.Char8 as B

solve :: Int -> B.ByteString -> Int64
solve k s
    | k == 0 = sum . map l2 . filter ((=='0') . B.head) $ B.group s
    | B.count '1' s < k = 0
    | otherwise = fst $ B.foldl' f (0, (kth, 1 + zeros kth s)) s
  where n = B.length s
        kth = (B.findIndices (== '1') s) !! (k-1)
        f (!a, (!j, !c)) d
            | d == '0' = (na, (j, c))
            | d == '1' = if j+c < n
                then (na, (j+c, 1 + zeros (j+c) s))
                else (na, (n, 0))
          where na = a + fromIntegral c

zeros :: Int -> B.ByteString -> Int
zeros i = B.length . B.takeWhile (== '0') . B.drop (i+1)

l2 :: B.ByteString -> Int64
l2 s = (l * (l+1)) `div` 2
  where l = fromIntegral $ B.length s

main = do
    [k', s] <- B.words <$> B.getContents
    let k = read . B.unpack $ k'
    putStrLn . show $ solve k s

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . lines)

solve :: [String] -> Integer
solve [sK, str] = answer where
    answer = case k of
        0 -> sum $ map (\x -> x * (x - 1) `div` 2) oneGroups
        _ -> sum $ zipWith (*) oneGroups (drop k oneGroups)
    oneGroups = map (fromIntegral . length) $ group sums :: [Integer]
    sums = elems sumArray

    sumArray = array allBounds [(i, sumArrayF i) | i <- range allBounds]
    allBounds = (0, snd $ bounds strArray)

    sumArrayF 0 = 0
    sumArrayF i = strArray ! i + sumArray ! (i - 1)

    strArray = listArray (1, length str) $ map ((\x -> x - ord '0') . ord) str
    k = read sK :: Int

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

main = print . solve =<< parse stdin
-- main = print . solve $ (215001, C.replicate (1000000) '1')

parse h = do
   input <- glines $ C.hGetContents h
   let k = readInt $ input !! 0
       s = input !! 1
   return (k, s)

solve :: (Int, C.ByteString) -> Integer
solve (k, s)
   | k == 0 = sum $ map g z
   | k /= 0 = sum $ zipWith f z (drop k z)
   where
      z     = map C.length . C.split '1' $ s
      f x y = (fromIntegral x + 1) * (fromIntegral y + 1)
      g x   = fromIntegral x * (fromIntegral x + 1) `div` 2

-- lib

glines = fmap (map (C.takeWhile (/='\r')) . C.lines)
readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

-- vim: set expandtab:

import Control.Monad
import Data.List
encode :: String -> [Integer]
encode s = let (s1, s2) = span (== '0') s
           in if null s2 then [genericLength s1 + 1]
                         else genericLength s1 + 1: encode (tail s2)
main = do
  k <- (liftM read) getLine
  s <- getLine
  let l = encode s
  putStrLn . show . sum $ if k == 0 then map (\x -> div (x * (x-1)) 2) l
                                    else zipWith (*) l (drop k l)

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

solve k s
	| k == 0 = sum $ map (\c -> c*(c-1) `div` 2) cs
	| otherwise = sum $ zipWith (*) cs $ drop k cs
	where
		cs = map fromIntegral . map ((+ 1) . length) $ split '1' s

main = do
	k <- readLn
	s <- getLine
	print $ solve k s

main = interact $ show.solve.(\[x,y]->(read x,y)).lines

solve :: (Int,String) -> Integer
solve (0,cs) = sum.map (\n->(n*(n-1))`div`2)$ f cs
solve (k,cs) = sum.s (zipWith (*)) (drop k) $ f cs
   where s g h x = g x (h x)

f :: String -> [Integer]
f cs = case span ('0'==) cs of
         (xs,(y:ys)) -> (succ.fromIntegral.length $ xs):f ys
         (xs,[])     -> return.succ.fromIntegral.length $ xs

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

solve k s
	| k == 0 = sum $ map (\c -> c*(c-1) `div` 2) cs
	| otherwise = sum $ zipWith (*) (drop k cs) cs
	where
		cs = map ((+ 1) . fromIntegral . length) $ split '1' s

main = do
	k <- readLn
	s <- getLine
	print $ solve k s

{- OPTIONS_GHC -O3 -fno-spec-constr-count -}
import Control.Monad
import Control.Applicative
import Data.Int
import Debug.Trace
import qualified Data.ByteString.Char8 as B

solve :: Int -> B.ByteString -> Integer
solve k s
    | k == 0 = sum . map l2 . filter ((=='0') . B.head) $ B.group s
    | B.count '1' s < k = 0
    | otherwise = fst $ B.foldl' f (0, (kth, 1 + zeros kth s)) s
  where n = B.length s
        kth = (B.findIndices (== '1') s) !! (k-1)
        f (a, (j, c)) d
            | d == '0' = (na, (j, c))
            | d == '1' = if j+c < n
                then (na, (j+c, 1 + zeros (j+c) s))
                else (na, (n, 0))
          where na = a + fromIntegral c

zeros :: Int -> B.ByteString -> Int
zeros i = B.length . B.takeWhile (== '0') . B.drop (i+1)

l2 :: B.ByteString -> Integer
l2 s = l * l
  where l = fromIntegral $ B.length s

main = do
    [k', s] <- B.words <$> B.getContents
    let k = read . B.unpack $ k'
    putStrLn . show $ solve k s

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . lines)

solve :: [String] -> Int
solve [sK, str] = answer where
    answer = case k of
        0 -> sum $ map (\x -> x * (x - 1) `div` 2) oneGroups
        _ -> sum $ zipWith (*) oneGroups (drop k oneGroups)
    oneGroups = map length $ group sums
    sums = elems sumArray

    sumArray = array allBounds [(i, sumArrayF i) | i <- range allBounds]
    allBounds = (0, snd $ bounds strArray)

    sumArrayF 0 = 0
    sumArrayF i = strArray ! i + sumArray ! (i - 1)

    strArray = listArray (1, length str) $ map ((\x -> x - ord '0') . ord) str
    k = read sK :: Int

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . lines)

solve :: [String] -> Int
solve [sK, str] = answer where
    answer = case k of
        0 -> length $ filter (=='0') str
        1 -> length $ filter (=='1') str
        _ -> sum $ zipWith (*) oneGroups (drop k oneGroups)
    oneGroups = map length $ group sums
    sums = elems sumArray

    sumArray = array allBounds [(i, sumArrayF i) | i <- range allBounds]
    allBounds = (0, snd $ bounds strArray)

    sumArrayF 0 = 0
    sumArrayF i = strArray ! i + sumArray ! (i - 1)

    strArray = listArray (1, length str) $ map ((\x -> x - ord '0') . ord) str
    k = read sK :: Int

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . lines)

solve :: [String] -> Int
solve [sK, str] = answer where
    answer = case k of
        0 -> length $ filter (=='0') str
        _ -> sum $ zipWith (*) oneGroups (drop k oneGroups)
    oneGroups = map length $ group sums
    sums = elems sumArray

    sumArray = array allBounds [(i, sumArrayF i) | i <- range allBounds]
    allBounds = (0, snd $ bounds strArray)

    sumArrayF 0 = 0
    sumArrayF i = strArray ! i + sumArray ! (i - 1)

    strArray = listArray (1, length str) $ map ((\x -> x - ord '0') . ord) str
    k = read sK :: Int

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

main = print . solve =<< parse stdin
-- main = print . solve $ (215001, C.replicate (1000000) '1')

parse h = do
   input <- glines $ C.hGetContents h
   let k = readInt $ input !! 0
       s = input !! 1
   return (k, s)

solve (k, s)
   | k == 0 = sum $ map g z
   | k /= 0 = sum $ zipWith f z (drop k z)
   where
      z     = map C.length . C.split '1' $ s
      f x y = (x + 1) * (y + 1)
      g x   = x * (x + 1) `div` 2

-- lib

glines = fmap (map (C.takeWhile (/='\r')) . C.lines)
readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

-- vim: set expandtab:

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

main = print . solve =<< parse stdin

parse h = do
   input <- glines $ C.hGetContents h
   let k = readInt $ input !! 0
       s = input !! 1
   return (k, s)

solve (k, s) = sum $ zipWith f z (drop k z)
   where
      z = map C.length . C.split '1' $ s
      f x y = (x + 1) * (y + 1)

-- lib

glines = fmap (map (C.takeWhile (/='\r')) . C.lines)
readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

-- vim: set expandtab:

import Control.Monad
import Data.List
encode s = let (s1, s2) = span (== '0') s
           in if null s2 then [length s1]
                         else length s1 : encode (tail s2)
main = do
  k <- (liftM read) getLine
  s <- getLine
  let l = encode s
      val = if k == 0 then sum $ map (\x -> div (x * (x+1)) 2) l
                      else sum $ zipWith (\x y -> (x+1) * (y+1)) l (drop k l)
  putStrLn $ show val

solve :: Int -> String -> Int
solve 0 _  =  0
solve n line  =  solve' ones (drop n ones) 0
  where
    ones  =  [0] ++ (map snd $ filter (('1' ==) . fst) (zip line [1..])) ++ [length line + 1]
    solve' :: [Int] -> [Int] -> Int -> Int
    solve' (l1:l2:ls) (r1:r2:rs) acc  =  acc' `seq` solve' (l2:ls) (r2:rs) acc'
      where
        acc'  =  acc + ((l2-l1)*(r2-r1))
    solve' _ _ acc  =  acc

main :: IO ()
main  =  do
    n <- readLn::IO Int
    line <- getLine
    print $ solve n line

import Data.List

main = interact $ show.solve.(\[x,y]->(read x,y)).lines

solve :: (Int,String) -> Int
solve (0,cs) = sum . map (h.length) . filter (('0'==).head) $ group cs
solve (k,cs) = let (xs1,xs2) = span ('0'==) cs
               in case f k ('1'==) xs2 of
                    Just ((y:ys),zs) -> let ws = takeWhile ('0'==) zs
                                        in (1+length xs1)*(1+length ws) + solve (k,ys++zs)
                    Nothing -> 0

f :: Int -> (a -> Bool) -> [a] -> Maybe ([a],[a])
f n p []
  | n==0      = Just ([],[])
  | otherwise = Nothing
f n p (x:xs)
  | n==0      = Just ([],x:xs)
  | p x       = f (n-1) p xs >>= g x
  | otherwise = f n p xs >>= g x

g :: a -> ([a],[a]) -> Maybe ([a],[a])
g x (xs,ys) = Just (x:xs,ys)

h n = (n*(n+1))`div`2

split x xs = split' xs
	where
		split' xs = xs' : if null xs'' then [] else split' $ tail xs''
			where
				(xs', xs'') = break (== x) xs

solve k s
	| k == 0 = sum $ map (\c -> c*(c-1) `div` 2) cs
	| otherwise = sum $ zipWith (*) (drop k cs) cs
	where
		cs = map ((+ 1) . length) $ split '1' s

main = do
	k <- readLn
	s <- getLine
	print $ solve k s


The GCD table G of size n × n for an array of positive integers a of length n is defined by formula   Let us remind you that the greatest common divisor (GCD) of two positive integers x and y is the greatest integer that is divisor of both x and y, it is denoted as . For example, for array a = {4, 3, 6, 2} of length 4 the GCD table will look as follows:  Given all the numbers of the GCD table G, restore array a.

The first line contains number n (1 ≤ n ≤ 500) — the length of array a. The second line contains n2 space-separated numbers — the elements of the GCD table of G for array a.  All the numbers in the table are positive integers, not exceeding 109. Note that the elements are given in an arbitrary order. It is guaranteed that the set of the input data corresponds to some array a.

In the single line print n positive integers — the elements of array a. If there are multiple possible solutions, you are allowed to print any of them.

import Control.Monad
import Data.IntMap hiding (map)
import Prelude hiding (lookup,null)

build m [] = m
build m (x:xs) = if lookup x m == Nothing then build (insert x 1 m) xs else build (update (return . succ) x m) xs

main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = build empty a
    mapM_ (\x -> putStr ((show x) ++ " ")) (solve m [])

solve m a
 |null m = a
 |otherwise = let x = getMax m
                  m' = deduct m (x:(map (gcd x) a))
              in solve m' (x:a)

getMax m = let Just ((k,_),_) = maxViewWithKey m in k

deduct m [] = m
deduct m (x:xs) = let v = lookup x m
                      nm = if v==Nothing then m else if v<=Just 2 then delete x m else adjust (\l -> l-2) x m
                  in deduct nm xs

import Data.List

main = interact $ solver

solver str = unwords $ map show res where
             _:ws = words str
             vals = map read ws
             res = solve (reverse $ sort $ vals) []

solve :: [Int] -> [Int] -> [Int]
solve [] res = res
solve (h:t) res = solve remaining (h : res) where
                  to_remove = map (gcd h) res
                  to_remove2 = reverse $ sort $ concatMap (replicate 2) to_remove
                  remaining = exclude t to_remove2

exclude [] _ = []
exclude v [] = v
exclude (h1:t1) v2@(h2:t2)
    | h1 == h2 = exclude t1 t2
    | h1 > h2  = h1 : exclude t1 v2

import Data.List

main = interact $ solver

solver str = unwords $ map show res where
             _:ws = words str
             vals = map read ws
             res = solve (reverse $ sort $ vals) []

solve :: [Int] -> [Int] -> [Int]
solve [] res = res
solve (h:t) res = solve remaining (h : res) where
                  to_remove = map (gcd h) res
                  to_remove2 = reverse $ sort $ to_remove
                  remaining = exclude t to_remove2

exclude [] _ = []
exclude v [] = v
exclude (h1:t1) v2@(h2:t2)
    | h1 == h2 = exclude (tail t1) t2
    | h1 > h2  = h1 : exclude t1 v2

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.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 (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  n <- readLn
  xs <- getInts

  let
    ms = Map.fromListWith (+) $ zip xs $ repeat 1

    f 0 _ r = r
    f n s r = f (n-1) s' (m:r)
      where
        m = fst $ Map.findMax s
        s' = foldl remove s $ m:(xs ++ xs)
          where
            xs = map (gcd m) r

            remove s x
              | c == 1 = x `Map.delete` s
              | otherwise = Map.adjust (\x -> x-1) x s
              where
                c = s Map.! x

  putStrLn $ unwords $ map show $ f n ms []

import Data.List
import Data.Map.Strict ((!))
import qualified Data.Map.Strict as Map

main = do
	(_ : xs) <- fmap (map read . words) getContents
	let m = Map.fromList $ fmap (\us@(u : _) -> (u, length us)) . group . sort $ xs
	foldl1 (>>) $ map (putStrLn . show) $ solve m []

solve m ans
	| Map.null m	= ans
	| otherwise		=
		let
			x		= fst $ Map.findMax m
			delList	= map (gcd x) ans
		in
			solve (foldl myDelete m (x : (delList ++ delList))) (x : ans)

myDelete m k = if (m ! k) == 1 then Map.delete k m else Map.adjust (subtract 1) k m

import Data.List
import Data.Map.Strict ((!))
import qualified Data.Map.Strict as Map

main = do
	(_ : xs) <- fmap (map read . words) getContents
	let m = Map.fromList $ fmap (\us@(u : _) -> (u, length us)) . group . sort $ xs
	foldl1' (>>) $ map (putStrLn . show) $ solve m []

solve m ans
	| Map.null m	= ans
	| otherwise		=
		let
			x		= fst $ Map.findMax m
			delList	= map (gcd x) ans
		in
			solve (foldl' myDelete m (x : (delList ++ delList))) (x : ans)

myDelete m k = if (m ! k) == 1 then Map.delete k m else Map.adjust (subtract 1) k m

import Data.List
import Data.Map.Strict ((!))
import qualified Data.Map.Strict as Map

main = do
	(_ : xs) <- fmap (map read . words) getContents
	let m = Map.fromList $ fmap (\us@(u : _) -> (u, length us)) . group . sort $ xs
	foldl1' (>>) $ map (putStrLn . show) $ solve m []

solve m ans
	| Map.null m	= ans
	| otherwise		=
		let
			x		= fst $ Map.findMax m
			delList	= map (gcd x) ans
		in
			solve (foldl myDelete m (x : (delList ++ delList))) (x : ans)

myDelete m k = if (m ! k) == 1 then Map.delete k m else Map.adjust (subtract 1) k m

import qualified Data.Map as Map
import Data.List as List

readInts str = map read (words str)

g ys m =
  if Map.null m then ys
  else  if k==0 then g ys (Map.delete y m)
  else g (y:ys) (Map.adjust (flip (-) 1) y m')
  where
    (y, k) = Map.findMax m
    gs = map (gcd y) ys
    m' = foldr (Map.adjust (flip (-) 2) ) m gs

main :: IO ()
main = do
 -- n <- fmap read getLine :: IO Int
  getLine
  xs <- fmap readInts getLine :: IO [Int]
  let xs' = List.group $ List.sort xs
  let m = Map.fromList $ map (\lst-> (head lst, length lst)) xs'
  putStr $ unwords $ map show (g [] m)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>), (<*>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

import Data.Map (Map, empty, alter, findMax, deleteMax, adjust)
import qualified Data.Map as M

solve :: [Int] -> [Int]
solve xs = loop [] (foldr (alter inc) empty xs :: Map Int Int)
    where
    inc Nothing  = Just 1
    inc (Just i) = Just $ 1 + i
    go = adjust $ \i -> i - 2

    loop acc cnt
        | M.null cnt = acc
        | otherwise  = case findMax cnt of
            (_, 0) -> loop acc (deleteMax cnt)
            (k, _) -> loop (k:acc) . foldr go (adjust pred k cnt) $ map (gcd k) acc

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

main :: IO ()
main = getLine >> getLine >>= putStrLn . unwords . map show . solve . parse

import Control.Monad
import Data.IntMap hiding (map)
import Prelude hiding (lookup,null)

build m [] = m
build m (x:xs) = if lookup x m == Nothing then build (insert x 1 m) xs else build (update (return . succ) x m) xs

main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let m = build empty a
    print $ solve m []

solve m a
 |null m = a
 |otherwise = let x = getMax m
                  m' = deduct m (x:(map (gcd x) a))
              in solve m' (x:a)

getMax m = let Just ((k,_),_) = maxViewWithKey m in k

deduct m [] = m
deduct m (x:xs) = let v = lookup x m
                      nm = if v==Nothing then m else if v<=Just 2 then delete x m else adjust (\l -> l-2) x m
                  in deduct nm xs

import qualified Data.Map as Map
import Data.List as List

readInts str = map read (words str)

g ys m =
  if Map.null m then ys
  else  if k==0 then g ys (Map.delete y m)
  else g (y:ys) (Map.deleteMax m')
  where
    (y, k) = Map.findMax m
    gs = map (gcd y) (y:ys)
    m' = foldr (Map.adjust (flip (-) 2) ) m gs

main :: IO ()
main = do
 -- n <- fmap read getLine :: IO Int
  getLine
  xs <- fmap readInts getLine :: IO [Int]
  let xs' = List.group $ List.sort xs
  let m = Map.fromList $ map (\lst-> (head lst, length lst)) xs'
  putStr $ unwords $ map show (g [] m)


You are given an array $$$a$$$ of $$$n$$$ positive integers. Determine if, by rearranging the elements, you can make the array strictly increasing. In other words, determine if it is possible to rearrange the elements such that $$$a_1 < a_2 < \dots < a_n$$$ holds.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$1 \leq a_i \leq 10^9$$$) — the elements of the array.

For each test case, output "YES" (without quotes) if the array satisfies the condition, and "NO" (without quotes) otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

NoteIn the first test case any rearrangement will keep the array $$$[1,1,1,1]$$$, which is not strictly increasing.In the second test case, you can make the array $$$[1,3,4,7,8]$$$.

import Data.List

solve :: [Int] -> String
solve [] = "Yes"
solve [x] = "Yes"
solve (a:xs@(b:_)) = if a==b then "No" else solve xs

testCase = do
    n <- getLine
    numList <- words `fmap` getLine
    let nums = read `map` numList :: [Int]
    putStrLn $ solve (sort nums)

repeatN 0 m = return []

repeatN n m = do
  x1 <- m
  x2 <- repeatN (n - 1) m
  return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatN n testCase

import Control.Monad (forM_)
import Data.List (nub)

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

main = do
  n <- readLn :: IO Int
  forM_
    [1 .. n]
    ( \_ -> do
        _ <- readLn :: IO Int
        arr <- readInts
        putStrLn $
          if (length . nub) arr == length arr
            then "YES"
            else "NO"
    )

import Data.List

solve :: [Int] -> String
solve [] = "Yes"
solve [x] = "Yes"
solve (a:b:xs) = if a==b then "No" else solve xs

testCase = do
    n <- getLine
    numList <- words `fmap` getLine
    let nums = read `map` numList :: [Int]
    putStrLn $ solve (sort nums)

repeatN 0 m = return []

repeatN n m = do
  x1 <- m
  x2 <- repeatN (n - 1) m
  return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatN n testCase

solve :: [Int] -> String
solve [] = "Yes"
solve [x] = "Yes"
solve (a:b:xs) = if a==b then "No" else solve xs

testCase = do
    n <- getLine
    numList <- words `fmap` getLine
    let nums = read `map` numList :: [Int]
    putStrLn $ solve nums

repeatN 0 m = return []

repeatN n m = do
  x1 <- m
  x2 <- repeatN (n - 1) m
  return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatN n testCase


BerOilGasDiamondBank has branches in n cities, at that n is an even number. The bank management wants to publish a calendar with the names of all those cities written in two columns: the calendar should consist of exactly n / 2 lines of strictly equal length, each of which contains exactly two names and exactly one separator character between them. The name of every city should be used in the calendar exactly once. For historical reasons the symbol d is used as the separator of words in the calendar. The BerOilGasDiamondBank management wants to show that all its branches are equally important to it, that's why the order of their appearance in the calendar should be following: if we "glue"(concatinate) all the n / 2 calendar lines (from top to bottom) to make a single line, then the lexicographically minimal line is obtained. No separator character will be used to separate calendar lines. For example, if the lines are "bertown!berville", "newberville!bera", then the resulting line is "bertown!bervillenewberville!bera". In some sense one has to find the lexicographically minimal calendar, where the comparison of calendars happens line by line.Help BerOilGasDiamondBank and construct the required calendar.

The first line contains an integer n (1 ≤ n ≤ 104, n is even) which is the number of branches. Then follow n lines which are the names of the cities. All the names consist of lowercase Latin letters; their lengths are no less than 1 and no more than 10 symbols. The next line contains a single symbol d (d has an ASCII-code from 33 to 126 inclusively, excluding lowercase Latin letters) which is the separator between words in the calendar lines. It is guaranteed that the calendar is possible to be constructed and all the names are different.

Print n / 2 lines of similar length which are the required calendar. Every line should contain exactly two words and exactly one separator between them. If there are several solutions, print the lexicographically minimal one. The lexicographical comparison of lines is realized by the "<" operator in the modern programming languages.

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

main = do
	n <- fmap read getLine
	a <- replicateM n getLine
	b <- getLine
	putStrLn $ gao n a b

gao n a b = unlines $ sort $ concat $ d : e where
	m = sum (map length a) * 2 `div` n
	c = fmap sort $ accumArray (flip (:)) [] (1, m) $ map (\i -> (length i, i)) a
	d = if odd m then [] else f $ c!(div m 2)
	e = [zipWith (\i j -> min (i ++ b ++ j) (j ++ b ++ i)) (c!i) (c!(m - i))| i <- [1 .. div (m - 1) 2]]
	f [] = []
	f (x:y:z) = (x ++ b ++ y) : f z

module Main where

import Control.Monad
import Data.Ord
import Data.Monoid
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.List

strCmp sep (a:as) (b:bs) = case compare a b of
    EQ -> strCmp sep as bs
    res -> res
strCmp sep [] (b:_) = compare sep b
strCmp sep (a:_) [] = compare a sep
strCmp sep _ _ = EQ

newtype Prefix = Prefix (Char, [Char]) deriving Eq
instance Ord Prefix where
    compare (Prefix (sep, a)) (Prefix (_, b)) = strCmp sep a b

main = do
    n <- read `liftM` getLine
    names <- replicateM n getLine
    sep <- head `liftM` getLine

    let prefixSet = Set.fromList $ map (\s -> Prefix (sep, s)) names
        postfixMap = Map.fromList $                                                                                map (\s -> (length (Set.findMin s), s)) $
            map Set.fromList $
            groupBy (\a b -> length a == length b) $
            sortBy (comparing length) names
        totalLen = sum $ map length names
        rowLen = totalLen `div` (n `div` 2) + 1
        (res, _, _) = until
            (\(_, set, _) -> Set.null set)
            (\(res, prefixSet, postfixMap) ->
                    let (Prefix (_, prefix), prefixSet') = Set.deleteFindMin prefixSet
                        prefixLen = length prefix
                        postfixLen = rowLen - 1 - prefixLen

                        postfixMap' = Map.insertWith' ( \_ entry -> Set.delete prefix entry ) prefixLen undefined postfixMap
                        (postfix, postfixSet'') = Set.deleteFindMin $ postfixMap' Map.! postfixLen
                        postfixMap'' = Map.insert postfixLen postfixSet'' postfixMap'

                        prefixSet'' = Set.delete (Prefix (sep, postfix)) prefixSet'
                    in ( ( prefix ++ [sep] ++ postfix ) : res, prefixSet'', postfixMap'' )
                )
            ([], prefixSet, postfixMap)

    --putStrLn $ show postfixMap
    putStr $ unlines $ reverse res

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

main = do
  n <- fmap read getLine
  a <- replicateM n getLine
  b <- getLine
  putStr $ gao n a b

gao :: Int -> [String] -> String -> String
gao n a b =
  unlines $ sort $ concat $ d : e
  where
    m = sum (map length a) * 2 `div` n
    c = fmap sort $ accumArray (flip (:)) [] (1, m) [(length i, i) | i <- a]
    --should use fmap
    --in this case fmap is for functor (Array Int)
    --not map
    --map is for [] functor, for [] functor fmap = map
    d = if odd m then [] else f $ c!(div m 2)
    e = [zipWith (\x y -> min (x ++ b ++ y) (y ++ b ++ x)) (c!i) (c!(m - i)) | i <- [1..div (m - 1) 2]]
    f [] = []
    f (x:y:z) = (x ++ b ++ y) : f z

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

main = do
	n <- fmap read getLine
	c <- replicateM n getLine
	d <- getLine
	putStrLn $ gao n c d

gao n a b = unlines $ sort $ concat $ d : e where
	m = sum (map length a) * 2 `div` n
	c = fmap sort $ accumArray (flip (:)) [] (1, m) $ map (\i -> (length i, i)) a
	d = if odd m then [] else f $ c!(div m 2)
	e = [zipWith (\i j -> min (i ++ b ++ j) (j ++ b ++ i)) (c!i) (c!(m - i))| i <- [1 .. div (m - 1) 2]]
	f [] = []
	f (x:y:z) = (x ++ b ++ y) : f z

import Data.List
import Data.Maybe

linesBuild _ [] = []
linesBuild c@(delimiter, minLength, maxLength) cs@(csh:cst) =
	let {(cs1, cs2h:cs2t) = splitAt (fromJust $
		findIndex (\x -> length x == minLength + maxLength - length csh)
			cst) cst} in
	(csh ++ [delimiter] ++ cs2h): linesBuild c (cs1 ++ cs2t)

main = do { ns <- getLine
	; let n = read ns
	; cities <- mapM (\_ -> getLine) [1..n]
	; delimiter <- getLine >>= (return . head)
	; let (minLength, maxLength) = let (l:lens) = sort $ map length cities in
		(l, head $ reverse lens)
	; mapM_ (\x -> putStr (x ++ "\n"))
		$ linesBuild (delimiter, minLength, maxLength) (sortBy
		(\a b -> compare (a++[delimiter]) (b++[delimiter])) cities)
}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort, unfoldr)

main :: IO ()
main = do
   n <- read <$> getLine :: IO Int
   branches <- replicateM n getLine
   d <- getLine
   let lengths = map length branches
   let size = (2 * sum lengths) `div` n
   let branches' = map init . sort . map ( ++ d) $ branches
   mapM_ putStrLn $ solve size d branches'

solve :: Int -> String -> [String] -> [String]
solve sz d branches = unfoldr cN branches
  where cN :: [String] -> Maybe (String, [String])
        cN ([]) = Nothing
        cN bs = Just (start ++ d ++ smC, leOv)
           where start = head bs
                 fSz = sz - length start
                 (p1, smC:p2) = break ((== fSz).length) (tail bs)
                 leOv = p1 ++ p2

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)

main :: IO ()
main = do
   n <- read <$> getLine :: IO Int
   branches <- replicateM n getLine
   d <- getLine
   let lengths = map length branches
   let size = (2 * sum lengths) `div` n
   let branches' = (map init) . sort . (map ( ++ d)) $ branches
   mapM_ putStrLn $ solve size d branches'

solve :: Int -> String -> [String] -> [String]
solve _ _ ([]) = []
solve sz d branches = (start ++ d ++ smC):(solve sz d leOv)
  where start = head branches
        fSz = sz - length start
        (p1, (smC:p2)) = break ((== fSz).length) (tail branches)
        leOv = p1 ++ p2

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

main = do
	n <- fmap read getLine
	a <- replicateM n getLine
	b <- getLine
	putStrLn $ gao n a b

gao n a b = unlines $ sort $ concat $ d : e where
	m = sum (map length a) * 2 `div` n
	c = accumArray (flip (:)) [] (1, m) $ map (\i -> (length i, i)) a
	d = if odd m then [] else f $ c!(div m 2)
	e = [zipWith (\i j -> min (i ++ b ++ j) (j ++ b ++ i)) (c!i) (c!(m - i))| i <- [1 .. div (m - 1) 2]]
	f [] = []
	f (x:y:z) = (x ++ b ++ y) : f z

import Control.Monad
import Data.Ord
import Data.Monoid
import qualified Data.Set as Set

strCmp sep (a:as) (b:bs) = case compare a b of
    EQ -> strCmp sep as bs
    res -> res
strCmp sep [] (b:_) = compare sep b
strCmp sep (a:_) [] = compare a sep
strCmp sep _ _ = EQ

newtype Prefix = Prefix (Char, [Char]) deriving Eq
instance Ord Prefix where
    compare (Prefix (sep, a)) (Prefix (_, b)) = strCmp sep a b

main = do
    n <- read `liftM` getLine
    names <- replicateM n getLine
    sep <- head `liftM` getLine

    let prefixSet = Set.fromList $ map (\s -> Prefix (sep, s)) names
        postfixSet = Set.fromList names
        (res, _, _) = until
            (\(_, set, _) -> Set.null set)
            (\(res, prefixSet, postfixSet) ->
                    let (Prefix (_, prefix), prefixSet') = Set.deleteFindMin prefixSet
                        (postfix, postfixSet') = Set.deleteFindMin $ Set.delete prefix postfixSet
                        prefixSet'' = Set.delete (Prefix (sep, postfix)) prefixSet'
                    in ( ( prefix ++ [sep] ++ postfix ) : res, prefixSet'', postfixSet' )
                )
            ([], prefixSet, postfixSet)

    putStr $ unlines $ reverse res

import Data.List
import Data.Maybe

linesBuild _ [] = []
linesBuild c@(delimiter, minLength, maxLength) cs@(csh:cst) =
	let {(cs1, cs2h:cs2t) = splitAt (fromJust $
		findIndex (\x -> length x == minLength + maxLength - length csh)
			cst) cst} in
	(csh ++ [delimiter] ++ cs2h): linesBuild c (cs1 ++ cs2t)

main = do { ns <- getLine
	; let n = read ns
	; cities <- mapM (\_ -> getLine) [1..n]
	; delimiter <- getLine >>= (return . head)
	; let (minLength, maxLength) = let (l:lens) = sort $ map length cities in
		(l, head $ reverse lens)
	; mapM_ (\x -> putStr (x ++ "\n"))
		$ linesBuild (delimiter, minLength, maxLength) (sort cities)
}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)

main :: IO ()
main = do
   n <- read <$> getLine :: IO Int
   branches <- sort <$> replicateM n getLine :: IO [String]
   d <- getLine
   let lengths = map length branches
   let size = (2 * sum lengths) `div` n
   mapM_ putStrLn $ solve size d branches

solve :: Int -> String -> [String] -> [String]
solve _ _ ([]) = []
solve sz d branches = (start ++ d ++ smC):(solve sz d leOv)
  where start = head branches
        fSz = sz - length start
        (p1, (smC:p2)) = break ((== fSz).length) (tail branches)
        leOv = p1 ++ p2


One day Vasya went out for a walk in the yard but there weren't any of his friends outside and he had no one to play touch and run. But the boy didn't lose the high spirits and decided to play touch and run with himself. You may ask: "How did he do that?" The answer is simple.Vasya noticed that the yard is a rectangular n × m field. The squares have coordinates (x, y) (1 ≤ x ≤ n, 1 ≤ y ≤ m), where x is the index of the row and y is the index of the column.Initially Vasya stands in the square with coordinates (xc, yc). To play, he has got a list of k vectors (dxi, dyi) of non-zero length. The game goes like this. The boy considers all vectors in the order from 1 to k, and consecutively chooses each vector as the current one. After the boy has chosen a current vector, he makes the maximally possible number of valid steps in the vector's direction (it is possible that he makes zero steps).A step is defined as one movement from the square where the boy is standing now, in the direction of the current vector. That is, if Vasya is positioned in square (x, y), and the current vector is (dx, dy), one step moves Vasya to square (x + dx, y + dy). A step is considered valid, if the boy does not go out of the yard if he performs the step.Vasya stepped on and on, on and on until he ran out of vectors in his list. Ha had been stepping for so long that he completely forgot how many steps he had made. Help the boy and count how many steps he had made.

The first input line contains two integers n and m (1 ≤ n, m ≤ 109) — the yard's sizes. The second line contains integers xc and yc — the initial square's coordinates (1 ≤ xc ≤ n, 1 ≤ yc ≤ m). The third line contains an integer k (1 ≤ k ≤ 104) — the number of vectors. Then follow k lines, each of them contains two integers dxi and dyi (|dxi|, |dyi| ≤ 109, |dx| + |dy| ≥ 1).

Print the single number — the number of steps Vasya had made. Please do not use the %lld specificator to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specificator.

NoteIn the first sample Vasya is initially positioned at square (1, 1) and makes 3 steps by the first vector (1, 1). So, he consecutively visits the squares (2, 2), (3, 3), (4, 4). Then he makes 0 steps by the second vector (1, 1). He makes 1 more step by the third vector (0,  - 2) and he ends up in square (4, 2). Overall, Vasya makes 4 steps.In the second sample Vasya is initially positioned in square (1, 2) and makes 0 steps by vector ( - 1, 0), as the square with coordinates (0, 2) is located outside the yard.

{-
import HUnit

testNotVectors :: Test
testNotVectors  =  Test "TestNotVectors" $
    assertEq 0 (solve (0,0) (0,0) [])

testOneVector :: Test
testOneVector  =  TestList "TestOneVector"
    [Test "1" $ assertEq 5 (solve (6,16) (1,1) [(1,1)]),
     Test "2" $ assertEq 2 (solve (6,16) (1,1) [(2,2)]),
     Test "3" $ assertEq 0 (solve (4,1) (1,1) [(1,1)])]

testOneVectorWithZeroCoordinate :: Test
testOneVectorWithZeroCoordinate  =  TestList "TestOneVectorWithZeroCoordinate"
    [Test "1" $ assertEq 3 (solve (4,1) (1,1) [(1,0)]),
     Test "2" $ assertEq 2 (solve (4,4) (2,2) [(0,1)])]

testOneVectorWithNegativeCoordinate :: Test
testOneVectorWithNegativeCoordinate  =  TestList "TestOneVectorWithNegativeCoordinate"
    [Test "1" $ assertEq 1 (solve (6,6) (2,2) [(-1,-1)]),
     Test "2" $ assertEq 2 (solve (6,6) (5,3) [(-1,-1)]),
     Test "3" $ assertEq 1 (solve (6,6) (5,3) [(-1,-2)])]

testManyVectors :: Test
testManyVectors  =  Test "TestManyVectors" $
    assertEq 7 (solve (3,4) (1,1) [(2,0),(0,1),(-1,0),(0,-3),(-1,0),(0,-1),(-1,-1),(3,0),(0,4)])

testInput :: Test
testInput  =  TestList "TestInput"
    [Test "1" $ assertEq 4 (solve (4,5) (1,1) [(1,1),(1,1),(0,-2)]),
     Test "2" $ assertEq 0 (solve (10,10) (1,2) [(-1,0)])]

testBig :: Test
testBig  =  Test "TestBig" $
    assertEq (10^9 * 1000) (solve (10^9 + 1, 10^9 + 1) (1,1) (take 1000 (cycle [(1,1), (-1,-1)])))

test :: IO ()
test  =  mapM_ run
    [testNotVectors,
     testOneVector,
     testOneVectorWithZeroCoordinate,
     testOneVectorWithNegativeCoordinate,
     testManyVectors,
     testInput,
     testBig]

--------------------------------------------------------------------------------
-}

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

readVector :: IO (Integer, Integer)
readVector  =  do
  [x, y]  <-  Main.reads
  return (x, y)

solve :: (Integer, Integer) -> (Integer, Integer) -> [(Integer, Integer)] -> Integer
solve (n,m) (x,y) vs  =  snd (foldl solve' ((x,y), 0) vs)
  where
    solve' :: ((Integer, Integer), Integer) -> (Integer, Integer) -> ((Integer, Integer), Integer)
    solve' ((xc,yc), s) (x,y)  =  ((xc + x * res, yc + y * res), s + res)
      where
        x'  =  if x < 0 then div (xc-1) (-x) else div (n-xc) x
        y'  =  if y < 0 then div (yc-1) (-y) else div (m-yc) y
        res  =  case (x,y) of
          (0, 0) ->  error "Solve: Empty vector!"
          (0, y) -> y'
          (x, 0) -> x'
          (x, y) -> min x' y'

main :: IO ()
main  =  do
    [n, m]  <-  Main.reads
    [xc, yc]  <-  Main.reads
    k  <-  readLn
    vs <- mapM (const readVector) [1..k]
    print $ solve (n,m) (xc,yc) vs

import Data.List

solve ([n, m]:position:_:vectors) = head $ foldl' applyVector (0:position) vectors
  where applyVector [ans, x, y] [dx, dy] =
          let a = steps x n dx
              b = steps y m dy
              c = min a b
          in [ans + c, x + c * dx, y + c * dy]

        steps a q da
          | da > 0    = (q - a) `div` da
          | da < 0    = (a - 1) `div` (abs da)
          | otherwise = 10 ^ 9 + 1

main = interact $ show . solve . map (map read . words) . lines

import Control.Arrow
import Control.Monad
main = do
  [n,m] <- liftM (map read . words) getLine
  [xc,yc] <- liftM (map read . words) getLine
  k <- readLn
  vs <- replicateM k $ liftM (((!!0) &&& (!!1)) . map read . words) getLine
  print $ solve n m xc yc vs 0
solve _ _ _ _ [] a = a
solve n m x y ((vx,vy):vs) a  = solve n m (x + c*vx) (y + c*vy) vs $! a + c
    where nx = if vx > 0 then (n - x) `div` vx else (1 - x) `div` vx
          ny = if vy > 0 then (m - y) `div` vy else (1 - y) `div` vy
          c = if vx == 0 then ny else if vy == 0 then nx else min nx ny

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

main = do
  [n,m] <- map read' . B.words <$> B.getLine
  [xc,yc] <- map read' . B.words <$> B.getLine
  _ <- getLine
  xys <- map ((\ [x,y] -> (x,y)) . map read' . B.words) . B.lines <$> B.getContents
  print $ solve [n,m] $ (xc,yc):xys

read' s = let Just (n,_) = B.readInt s in toInteger n

solve :: [Integer] -> [(Integer,Integer)] -> Integer
solve [n,m] (xy:xys) = fst $ foldl' (f [n,m]) (0,xy) xys

f [n,m] (i,(x,y)) (dx,dy)
  | dx == 0 = let k = if dy>0 then div (m-y) dy else div (1-y) dy
                    in (i+k,(x,y+k*dy))
  | dy == 0 = let k = if dx>0 then div (n-x) dx else div (1-x) dx
                    in (i+k,(x+k*dx,y))
  | otherwise = let kx = if dx>0 then div (n-x) dx else div (1-x) dx
                    ky = if dy>0 then div (m-y) dy else div (1-y) dy
                    k = min kx ky
                      in (i+k,(x+k*dx,y+k*dy))

import Data.List

bounds :: Integer->Integer->Integer->Integer
bounds n c dc
	| dc == 0 = 1000000001
	| dc < 0 = (1-c)`div`dc
	| otherwise = (n-c)`div`dc

travel n m  = go where
	go _ _ [] = 0
	go x y ([dx,dy]:t) = steps + go (x+steps*dx) (y+steps*dy) t
		where steps = min (bounds n x dx) (bounds m y dy)

result ([n,m]:[x,y]:_:v) = travel n m x y v

main=interact$show.result.map (map read.words).lines

import Control.Monad

type Point = (Int, Int)

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

solve :: [Point] -> Point -> Point -> Integer
solve points start (n, m) = loop points start 0
    where loop :: [Point] -> Point -> Integer -> Integer
          loop [] _ acc = acc
          loop ((vx, vy):vs) (x, y) acc =
              loop vs (x + st * vx, y + st * vy) (acc + (toInteger st))
              where st = min (step x vx n) (step y vy m)
                    step a va k
                        | va == 0 = 10^10 -- aka infty
                        | va > 0  = (k - a) `div` va
                        | va < 0  = (1 - a)`div` va

main = do
  (n, m) <- (getLine >>= return . l2t . map (read::String->Int) . words)
  (x, y) <- (getLine >>= return . l2t . map (read::String->Int) . words)
  [k] <- (getLine >>= return . map (read::String->Int) . words)
  points <- forM [1..k] (\_ -> getLine >>= (return . l2t . map (read::String->Int). words))
  print $ solve points (x, y) (n, m)


A class of students wrote a multiple-choice test.There are $$$n$$$ students in the class. The test had $$$m$$$ questions, each of them had $$$5$$$ possible answers (A, B, C, D or E). There is exactly one correct answer for each question. The correct answer for question $$$i$$$ worth $$$a_i$$$ points. Incorrect answers are graded with zero points.The students remember what answers they gave on the exam, but they don't know what are the correct answers. They are very optimistic, so they want to know what is the maximum possible total score of all students in the class.

The first line contains integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1000$$$) — the number of students in the class and the number of questions in the test. Each of the next $$$n$$$ lines contains string $$$s_i$$$ ($$$|s_i| = m$$$), describing an answer of the $$$i$$$-th student. The $$$j$$$-th character represents the student answer (A, B, C, D or E) on the $$$j$$$-th question. The last line contains $$$m$$$ integers $$$a_1, a_2, \ldots, a_m$$$ ($$$1 \le a_i \le 1000$$$) — the number of points for the correct answer for every question.

Print a single integer — the maximum possible total score of the class.

NoteIn the first example, one of the most optimal test answers is "ABCD", this way the total number of points will be $$$16$$$.In the second example, one of the most optimal test answers is "CCC", this way each question will be answered by exactly one student and the total number of points is $$$5 + 4 + 12 = 21$$$.

import Control.Monad
import Data.String
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Int]
parseLineToInt data_s = do
  (read::String->Int) <$> (words data_s)

countLetters :: [Char] -> Char -> Int
countLetters array_ char_ = length (filter (==char_) array_)

scoreCount :: [String] -> Int -> [Int]
scoreCount answList questionNumber =
  if (0 == length (answList!!0))
  then []
  else do
    let currentAnswer = (!!0) <$> answList
    let restAnswers = (drop 1) <$> answList
    let answers = ['A','B','C','D','E']
    let maxScore = maximum ((countLetters currentAnswer) <$> answers)
    maxScore : scoreCount restAnswers (questionNumber + 1)

myDot :: [Int] -> [Int] -> Int
myDot x y = sum (zipWith (*) x y)

main = do
  dataInts <- getLine
  let nm_ = parseLineToInt dataInts
  let n = nm_!!0
  let m = nm_!!1
  y <- readListRec n
  let maxVal = scoreCount y 0
  scoresStr <- getLine
  let scores = parseLineToInt scoresStr
  print (myDot scores maxVal)


At the beginning of the new semester there is new schedule in the Berland State University. According to this schedule, n groups have lessons at the room 31. For each group the starting time of the lesson and the finishing time of the lesson are known. It has turned out that it is impossible to hold all lessons, because for some groups periods of their lessons intersect. If at some moment of time one groups finishes it's lesson, and the other group starts the lesson, their lessons don't intersect.The dean wants to cancel the lesson in one group so that no two time periods of lessons of the remaining groups intersect. You are to find all ways to do that.

The first line contains integer n (1 ≤ n ≤ 5000) — amount of groups, which have lessons in the room 31. Then n lines follow, each of them contains two integers li ri (1 ≤ li < ri ≤ 106) — starting and finishing times of lesson of the i-th group. It is possible that initially no two lessons intersect (see sample 1).

Output integer k — amount of ways to cancel the lesson in exactly one group so that no two time periods of lessons of the remaining groups intersect. In the second line output k numbers — indexes of groups, where it is possible to cancel the lesson. Groups are numbered starting from 1 in the order that they were given in the input. Output the numbers in increasing order.

import Control.Monad (liftM, replicateM)
import Data.Array ((!), listArray, accumArray, elems)
import Data.List (intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

prints :: Show a => [a] -> IO ()
prints xs  =  print (length xs) >> prints' xs
  where
    prints'  =  putStrLn . intercalate " " . map show

solve :: Int -> [[Int]] -> [Int]
solve n groups  =  [i | i <- [1..n], countEdges == countEdge ! i]
  where
    groupsArray  =  listArray (1, n) groups
    countEdge  =  accumArray (+) 0 (1, n)
        [(i, length (edges i)) | i <- [1..n]]
    countEdges  =  div (sum (elems countEdge)) 2
    edges i  =  filter (intersect i) [1..n]
    intersect i j
      | i == j  =  False
      | otherwise
          =  l2 <= l1 && l1 < r2
          || l2 < r1 && r1 <= r2
          || l1 <= l2 && l2 < r1
          || l1 < r2 && r2 <= r1
      where
        [l1, r1]  =  groupsArray ! i
        [l2, r2]  =  groupsArray ! j

main :: IO ()
main  =  do
    n  <-  readLn
    groups  <-  replicateM n reads :: IO [[Int]]
    prints $ solve n groups

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

main :: IO ()
main = do
  n <- readLn
  temp <- replicateM n $ sort . map read . words <$> getLine :: IO [[Int]]
  let groups =  sortBy (comparing  snd) $ zip [1.. ] temp
      answers = sort . map fst . (`mapMaybe` groups) $ \g -> do
        let groups' = filter (/= g) groups
            check (_, _ : end : _) (_, start : _) = end <= start
        if and $ zipWith check groups' (tail groups')
          then Just g
          else Nothing
  print $ length answers
  putStrLn . intercalate " " $ map show answers

main = interact (ans)
ans theInput = output $ answer $ intersect schedule where
	inputs = map (map (read::String->Int))(map words $ lines theInput)
	[n] = head inputs
	schedule = zip [1..n] [(l,r)|[l,r]<-take n $ tail inputs]
	intersect [_] = []
	intersect ((i,(a,b)):xs) = [(i,j)|(j,(c,d))<-xs,(a<=c && c<b)||(c<=a && a<d)] ++ intersect xs
	answer [] = [1..n]
	answer ((i,j):xs) = [k|k<-[i,j],elem k $ answer xs]
	output x = unlines $ map unwords $ map (map show) [[length x],x]

import Data.List(find,sort)
main = do
  (_:input) <- fmap lines getContents
  let a :: [(Int,(Int,Int))]
      a = zip [1..] $ map parse input
      parse s = (l,r)
        where [l,r] = map read . words $ s
      n = length a
      ans = case find intersecting [(g,h) | g <- a, h <- a, fst g < fst h] of
              Nothing -> [1..n]
              Just ((i,(lx,rx)),(j,(ly,ry))) -> sort . filter good $ [i,j]

      intersecting ((_,(lx,rx)),(_,(ly,ry))) =
        rx > ly && lx < ry

      good idx = Nothing == find intersecting [(g,h) | g <- a, h <- a, fst g < fst h, fst g /= idx, fst h /= idx]

  print (length ans)
  putStrLn . unwords . map show $ ans

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: [Int] -> [(Int, Int, Int)]
solve xs  =  [(i, j, k) | i <- [1..n], j <- [1..n], k <- [1..n],
    i /= j, i /= k, j /= k,
    xs !! (i-1) == xs !! (j-1) + xs !! (k-1)]
  where
    n  =  length xs

printAns :: [(Int, Int, Int)] -> IO ()
printAns []  =  print (-1)
printAns ((i, j, k):xs)  =  putStrLn $ concat [show i, " ", show j, " ", show k]

main :: IO ()
main  =  getLine >> Main.reads >>= printAns . solve


This is an interactive problem.Baby Ehab loves crawling around his apartment. It has $$$n$$$ rooms numbered from $$$0$$$ to $$$n-1$$$. For every pair of rooms, $$$a$$$ and $$$b$$$, there's either a direct passage from room $$$a$$$ to room $$$b$$$, or from room $$$b$$$ to room $$$a$$$, but never both.Baby Ehab wants to go play with Baby Badawy. He wants to know if he could get to him. However, he doesn't know anything about his apartment except the number of rooms. He can ask the baby sitter two types of questions:   is the passage between room $$$a$$$ and room $$$b$$$ directed from $$$a$$$ to $$$b$$$ or the other way around?  does room $$$x$$$ have a passage towards any of the rooms $$$s_1$$$, $$$s_2$$$, ..., $$$s_k$$$? He can ask at most $$$9n$$$ queries of the first type and at most $$$2n$$$ queries of the second type.After asking some questions, he wants to know for every pair of rooms $$$a$$$ and $$$b$$$ whether there's a path from $$$a$$$ to $$$b$$$ or not. A path from $$$a$$$ to $$$b$$$ is a sequence of passages that starts from room $$$a$$$ and ends at room $$$b$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 30$$$) — the number of test cases you need to solve. Then each test case starts with an integer $$$n$$$ ($$$4 \le n \le 100$$$) — the number of rooms. The sum of $$$n$$$ across the test cases doesn't exceed $$$500$$$.

To print the answer for a test case, print a line containing "3", followed by $$$n$$$ lines, each containing a binary string of length $$$n$$$. The $$$j$$$-th character of the $$$i$$$-th string should be $$$1$$$ if there's a path from room $$$i$$$ to room $$$j$$$, and $$$0$$$ if there isn't. The $$$i$$$-th character of the $$$i$$$-th string should be $$$1$$$ for each valid $$$i$$$. After printing the answer, we will respond with a single integer. If it's $$$1$$$, you printed a correct answer and should keep solving the test cases (or exit if it is the last one). If it's $$$-1$$$, you printed a wrong answer and should terminate to get Wrong answer verdict. Otherwise, you can get an arbitrary verdict because your solution will continue to read from a closed stream.

NoteIn the given example:The first query asks whether there's a passage from room $$$3$$$ to any of the other rooms.The second query asks about the direction of the passage between rooms $$$0$$$ and $$$1$$$.After a couple other queries, we concluded that you can go from any room to any other room except if you start at room $$$3$$$, and you can't get out of this room, so we printed the matrix:1111111111110001The interactor answered with $$$1$$$, telling us the answer is correct.

import System.IO
import Control.Monad
import Data.Maybe
import Data.Foldable
import Data.Array
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Data.Time.Clock.System
import Data.Bits

getInt :: IO Int
getInt = parseInt <$> C.getLine

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

joinComps :: [Int] -> Seq.Seq [Int] -> [Int]
joinComps xs s = foldl' (flip (++)) xs s

type PairSet = (Int, S.Set (Int, Int))

query1 :: PairSet -> Int -> Int -> IO (Bool, PairSet)
query1 ps@(c, st) x y
  | S.member (x, y) st = return (True, ps)
  | S.member (y, x) st = return (False, ps)
  | otherwise = do
      C.putStrLn $ C.pack $ "1 " ++ show x ++ " " ++ show y
      hFlush stdout
      reply <- getInt
      when (reply == -1) $ error ""
      let p = if reply == 1 then (x, y) else (y, x)
      return $ (reply == 1, (c + 1, S.insert p st))

query2 :: Int -> Seq.Seq [Int] -> IO Bool
query2 x s = do
  let num = foldl' (\total xs -> total + length xs) 0 s
  C.putStrLn $ C.pack $ "2 " ++ show x ++ " " ++ show num ++ " " ++ unwords (map show (joinComps [] s))
  hFlush stdout
  reply <- getInt
  when (reply == -1) $ error ""
  return $ reply == 1

solve1 :: Int -> (PairSet, Seq.Seq [Int]) -> IO (PairSet, Seq.Seq [Int])
solve1 x (ps, Seq.Empty) = return (ps, Seq.singleton [x])
solve1 x (ps, [y] Seq.:<| Seq.Empty) = return (ps, Seq.fromList [[y], [x]])
solve1 x (ps, xs Seq.:<| s) = do
  let acc (True, tps) _ = return (True, tps)
      acc (False, tps) y = query1 tps x y
  result <- foldM acc (False, ps) xs
  case result of
    (True, ps') -> return (ps', Seq.singleton $ joinComps (x : xs) s)
    (False, ps') -> solve1 x (ps', s) >>= \(ps'', s') -> return (ps'', xs Seq.<| s')

solve2 :: Int -> Seq.Seq [Int] -> IO (Seq.Seq [Int])
solve2 x Seq.Empty = return (Seq.singleton [x])
solve2 x ([y] Seq.:<| Seq.Empty) = return (Seq.fromList [[y], [x]])
solve2 x s = do
  f <- query2 x s
  case f of
    True -> work s
    False -> return (s Seq.|> [x])
  where work Seq.Empty = return (Seq.singleton [x])
        work (xs Seq.:<| Seq.Empty) = return (Seq.singleton $ x : xs)
        work xss = do
          let (ls, rs) = Seq.splitAt (Seq.length xss `div` 2) xss
          ff <- query2 x ls
          case ff of
            True -> work ls >>= \(s' Seq.:|> xs) -> return (s' Seq.|> joinComps xs rs)
            False -> work rs >>= \s' -> return (ls Seq.>< s')

solve :: Int -> Int -> PairSet -> [Int] -> IO (PairSet, Seq.Seq [Int])
solve _ _ ps [] = return (ps, Seq.empty)
solve _ _ ps [x] = return (ps, Seq.singleton [x])
solve n len ps (x : xs) = do
  (ps'@(c', _), s) <- solve n (len - 1) ps xs
  if c' + len - 1 <= 9 * n
    then solve1 x (ps', s)
    else solve2 x s >>= \s' -> return (ps', s')

solveSort :: Int -> [Int] -> IO (PairSet, [Int])
solveSort _ [] = return ((0, S.empty), [])
solveSort _ [x] = return ((0, S.empty), [x])
solveSort n s = do
  ((c1, st1), ls) <- solveSort n1 s1
  ((c2, st2), rs) <- solveSort n2 s2
  merge (c1 + c2, S.union st1 st2) ls rs
  where n1 = n `div` 2
        n2 = n - n1
        (s1, s2) = splitAt n1 s
        merge ps [] ys = return (ps, ys)
        merge ps xs [] = return (ps, xs)
        merge ps (x : xs) (y : ys) = do
          (f, ps') <- query1 ps x y
          case f of
            True -> merge ps' xs (y : ys) >>= \(ps'', s') -> return (ps'', x : s')
            False -> merge ps' (x : xs) ys >>= \(ps'', s') -> return (ps'', y : s')

output :: Int -> Seq.Seq [Int] -> IO ()
output n comps = do
  let ps = zip [1 :: Int ..] $ toList comps
      func (idx, xs) = zip xs $ repeat idx
      a = array (0, n - 1) $ concat $ map func ps
  C.putStrLn $ C.pack "3"
  C.putStr $ C.pack $ unlines [[if a!i <= a!j then '1' else '0' | j <- [0..n-1]] | i <- [0..n-1]]
  hFlush stdout
  reply <- getInt
  when (reply /= 1) $ error ""

main :: IO ()
main = do
  t <- getInt
  replicateM_ t $ do
    n <- getInt
    (ps, xs') <- solveSort n [0..n-1]
    (_, comps) <- solve n n ps (reverse xs')
    output n comps


In Berland, there is the national holiday coming — the Flag Day. In the honor of this event the president of the country decided to make a big dance party and asked your agency to organize it. He has several conditions:  overall, there must be m dances; exactly three people must take part in each dance; each dance must have one dancer in white clothes, one dancer in red clothes and one dancer in blue clothes (these are the colors of the national flag of Berland). The agency has n dancers, and their number can be less than 3m. That is, some dancers will probably have to dance in more than one dance. All of your dancers must dance on the party. However, if some dance has two or more dancers from a previous dance, then the current dance stops being spectacular. Your agency cannot allow that to happen, so each dance has at most one dancer who has danced in some previous dance. You considered all the criteria and made the plan for the m dances: each dance had three dancers participating in it. Your task is to determine the clothes color for each of the n dancers so that the President's third condition fulfilled: each dance must have a dancer in white, a dancer in red and a dancer in blue. The dancers cannot change clothes between the dances.

The first line contains two space-separated integers n (3 ≤ n ≤ 105) and m (1 ≤ m ≤ 105) — the number of dancers and the number of dances, correspondingly. Then m lines follow, describing the dances in the order of dancing them. The i-th line contains three distinct integers — the numbers of the dancers that take part in the i-th dance. The dancers are numbered from 1 to n. Each dancer takes part in at least one dance.

Print n space-separated integers: the i-th number must represent the color of the i-th dancer's clothes (1 for white, 2 for red, 3 for blue). If there are multiple valid solutions, print any of them. It is guaranteed that at least one solution exists.

import Control.Monad (liftM, replicateM, when)
import Data.Array.IO (IOUArray, getElems, newArray, readArray, writeArray)
import Data.Char (ord)
import Data.List (intercalate)

type Tuple  =  (Int, Int, Int)
type Color  =  Int

next :: Color -> Color
next 1  =  2
next 2  =  3
next 3  =  1

solve :: Int -> Int -> [Tuple] -> IO [Int]
solve n m tuples  =  do
    array  <-  newArray (1, n) 0  :: (IO (IOUArray Int Int))
    mapM_ (solve' array) tuples
    x  <-  readArray array 1
    getElems array
  where
    solve' array (i, j, k)  =  do
      [a, b, c]  <-  mapM (readArray array) [i, j, k]
      when (a == 0 && b == 0 && c == 0) $ do
        writeArray array i 1
        writeArray array j 2
        writeArray array k 3
      when (a > 0) $ do
        writeArray array j (next a)
        writeArray array k (next $ next a)
      when (b > 0) $ do
        writeArray array i (next b)
        writeArray array k (next $ next b)
      when (c > 0) $ do
        writeArray array i (next c)
        writeArray array j (next $ next c)

main :: IO ()
main  =  do
    [n, m]  <-  reads
    tuples  <-  replicateM m readTuple
    solve n m tuples >>= prints

  where

    readTuple :: IO Tuple
    readTuple  =  do
        [x, y, z]  <-  reads
        return (x, y, z)

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show


Let's denote correct match equation (we will denote it as CME) an equation $$$a + b = c$$$ there all integers $$$a$$$, $$$b$$$ and $$$c$$$ are greater than zero.For example, equations $$$2 + 2 = 4$$$ (||+||=||||) and $$$1 + 2 = 3$$$ (|+||=|||) are CME but equations $$$1 + 2 = 4$$$ (|+||=||||), $$$2 + 2 = 3$$$ (||+||=|||), and $$$0 + 1 = 1$$$ (+|=|) are not.Now, you have $$$n$$$ matches. You want to assemble a CME using all your matches. Unfortunately, it is possible that you can't assemble the CME using all matches. But you can buy some extra matches and then assemble CME!For example, if $$$n = 2$$$, you can buy two matches and assemble |+|=||, and if $$$n = 5$$$ you can buy one match and assemble ||+|=|||.   Calculate the minimum number of matches which you have to buy for assembling CME.Note, that you have to answer $$$q$$$ independent queries.

The first line contains one integer $$$q$$$ ($$$1 \le q \le 100$$$) — the number of queries. The only line of each query contains one integer $$$n$$$ ($$$2 \le n \le 10^9$$$) — the number of matches.

For each test case print one integer in single line — the minimum number of matches which you have to buy for assembling CME.

NoteThe first and second queries are explained in the statement.In the third query, you can assemble $$$1 + 3 = 4$$$ (|+|||=||||) without buying matches.In the fourth query, buy one match and assemble $$$2 + 4 = 6$$$ (||+||||=||||||).

main = interact $ unlines . map (show . solve . read) . tail . lines
solve n | n < 4 = 4 - n
        | odd n = 1
        | even n = 0

findN::Int->Int
findN n | n<4 = 4 - n
findN n | (mod n 2) == 0 = 0
findN n = 1

inputN::Int->IO [Int]
inputN 0 = return []
inputN n = do
  z <- read <$> getLine
  (z:) <$> (inputN (n-1))

main::IO()
main = do
  n <- read <$> getLine
  lst <- inputN n
  mapM_ (print . findN) lst

f 2 = 2
f a = a `mod` 2

main = do
     x <- getLine
     y <- getContents
     mapM_ (putStrLn.show.f.read) $ lines y

f x
   | x == 2 = 2
   | otherwise = if odd x then 1 else 0

main = interact $ unlines . map ( show . f .  (read :: String -> Int) ) . tail . lines

main :: IO ()
main = interact (unlines . map (show . solve . read) . tail . lines)

solve :: Int -> Int
solve n = max (4 - n) (n `mod` 2)

import Control.Monad

main = do
  q <- read <$> getLine
  forM [1..q] $ \_ -> do
    n <- read <$> getLine
    print $ missing n

missing :: Int -> Int
missing 2 = 2
missing n
  | n `mod` 2 == 0 = 0
  | otherwise      = 1

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

process aa = print $ if aa==2 then 2 else if even aa then 0 else 1

main::IO ()
main=do
	s<- read <$> getLine:: IO Int
	a<- map read <$> replicateM s getLine ::IO [Int]
	mapM_ process a

--ghc 7.10

minMatches :: Int -> Int
minMatches n
    | n < 4 = 4 - n
    | otherwise = n `mod` 2

assembleCME :: [Int] -> [Int]
assembleCME = map minMatches

main = do
    qStr <- getLine
    contents <- getContents
    let ns = map read . words $ contents :: [Int]
    sequence . map print . assembleCME $ ns