A lot of people in Berland hates rain, but you do not. Rain pacifies, puts your thoughts in order. By these years you have developed a good tradition — when it rains, you go on the street and stay silent for a moment, contemplate all around you, enjoy freshness, think about big deeds you have to do. Today everything had changed quietly. You went on the street with a cup contained water, your favorite drink. In a moment when you were drinking a water you noticed that the process became quite long: the cup still contained water because of rain. You decided to make a formal model of what was happening and to find if it was possible to drink all water in that situation. Thus, your cup is a cylinder with diameter equals d centimeters. Initial level of water in cup equals h centimeters from the bottom.   You drink a water with a speed equals v milliliters per second. But rain goes with such speed that if you do not drink a water from the cup, the level of water increases on e centimeters per second. The process of drinking water from the cup and the addition of rain to the cup goes evenly and continuously. Find the time needed to make the cup empty or find that it will never happen. It is guaranteed that if it is possible to drink all water, it will happen not later than after 104 seconds.Note one milliliter equals to one cubic centimeter.

The only line of the input contains four integer numbers d, h, v, e (1 ≤ d, h, v, e ≤ 104), where:   d — the diameter of your cylindrical cup,  h — the initial level of water in the cup,  v — the speed of drinking process from the cup in milliliters per second,  e — the growth of water because of rain if you do not drink from the cup.

If it is impossible to make the cup empty, print "NO" (without quotes). Otherwise print "YES" (without quotes) in the first line. In the second line print a real number — time in seconds needed the cup will be empty. The answer will be considered correct if its relative or absolute error doesn't exceed 10 - 4. It is guaranteed that if the answer exists, it doesn't exceed 104.

NoteIn the first example the water fills the cup faster than you can drink from it.In the second example area of the cup's bottom equals to , thus we can conclude that you decrease the level of water by  centimeters per second. At the same time water level increases by 1 centimeter per second due to rain. Thus, cup will be empty in  seconds.

module Main where

main :: IO ()
main = do
	[d, h, v, e] <- getRs
	case res d h v e of
		Nothing -> putStrLn "NO"
		Just t -> do
                    putStrLn "YES"
                    print t

getRs :: IO [Float]
getRs = do
	s <- getLine
	return $ map read $ words s

area :: (Ord a, Fractional a, Floating a) => a -> a
area d = let r = d / 2
         in r^2 * pi

res :: (Ord a, Fractional a, Floating a) => a -> a -> a -> a -> Maybe a
res d h v e = let a = area d
              in resA h v e a

resA :: (Ord a, Fractional a, Floating a) => a -> a -> a -> a -> Maybe a
resA h v e a = let discr = v - e * a
               in if discr > 0 then Just ( h * a / discr) else Nothing

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

solve :: [Double] -> Maybe Double
solve [d, h, v, e] | pi / 4.0 * d * d * e > v = Nothing
                   | otherwise = Just ((pi / 4.0 * d * d * h) / (v - pi / 4.0 * d * d * e))

output :: Maybe Double -> IO()
output Nothing = putStrLn "NO"
output (Just x) = putStrLn $ "YES\n" ++ show x

{-# 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
  [d, h, v, e] <- fmap (map read . words) getLine

  let x = h*pi*d^2/4 / (v - e*pi*d^2/4) :: Double

  if x < 0
     then putStrLn "NO"
     else do
       putStrLn "YES"
       print x

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

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

main = do
  [d, h, v, e] <- fmap (map read . words) getLine
  maybe (putStrLn "NO") (\x -> putStrLn "YES" >> print x) (solve d h v e)

solve :: Double -> Double -> Double -> Double -> Maybe Double
solve d h v e | v - e' > epsilon = Just $ (h*pi *(d/2)**2)/(v - e')
              | otherwise = Nothing
              where
                e' = e*pi*(d/2)**2
                epsilon = 10**(-6)

solve::(Double, Double, Double, Double) -> String
solve (d,h,v,e) = do
		let a = e * d * d * pi / 4
		if v <= a then "NO" else "YES\n" ++ show ((h * d * d * pi/4)/(v - a))

main = getLine >>= (putStrLn . solve . getFour . map (\x -> read x :: Double) . words)
	where
		getFour (a : b : c : d : xz) = (a, b, c, d)

main = getLine >>= putStr . unlines . solve . map (read :: String -> Double) . words

solve [d, h, v, e] = if dh < 0
                     then ["YES", show (-h / dh)]
                     else ["NO"]
                         where dh = e - 4 * v / (pi * d * d)

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

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

main = do
  xs <- map fromIntegral . readIntN <$> BS.getLine
  printMaybe $ solve xs

solve :: [Double] -> Maybe Double
solve [d,h,v,e] = if 0 < ans && ans < 10000 then Just ans else Nothing where
  ans = h/(4*v/pi/d/d - e)

printMaybe (Just x) = do
  putStrLn "YES"
  print x
printMaybe Nothing = do
  putStrLn "NO"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- if not applying, use "const"

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

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

main = do
	input <- getLine
	let [d, h, v, e] = map (read::String->Double) $ words input
	let	ans = h/(4*v/pi/d^2-e)
	if (ans > 0) && (ans /= 1/0)
		then putStrLn $ ("YES\n" ++) $ show ans
		else putStrLn "NO"

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

main=do
	 [d,h,v,e]<- map read.words <$> getLine::IO [Double]
	 if pi/4.0 *d*d *e >v then putStrLn "NO"
			      else do
					putStrLn "YES"
					print $  (pi/4.0 *d*d *h) / (v-pi/4.0 *d*d *e)

main = do
  [d, h, v, e] <- getLine >>= return. map read. words
  let ans = a * h / (v - e * a) where a = (d / 2)^2 * pi
  putStrLn $ if ans < 0 then "NO" else "YES"
  putStr $ if ans < 0 then [] else show ans ++ "\n"

main = do
    s <- getLine
    let [d, h, v, e] = map read . words $ s
        v' = v / (3.1415926 * d * d / 4)
        res = h / (v' - e)
    if v' <= e
    then putStrLn "NO"
    else putStrLn "YES" >> print res

import Data.Bits

-- import Data.List (List)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import System.IO
import Text.Read

parseLine :: IO [Double]
parseLine = do
  input <- getLine
  return ((map read . words) input :: [Double])

solveN 0 ans = return ans
solveN n ans = do
  ls <- parseLine
  let [d, h, v, e] = ls
  solveN 0 (pi * d ^ 2 * h / (4 * v - pi * d ^ 2 * e))

main :: IO ()
main
  -- input <- getLine
  -- let (n:k:_) = (map read . words) input :: [Int]
  -- p <- parseLine
 = do
  input <- solveN 1 0.0
  if input >= 0
    then do
      putStrLn "YES"
      print input
    else putStrLn "NO"

{-
instructions go here...
-}

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

solve :: Float -> Float -> Float -> Float -> Maybe Float
solve d h v e = if vPlus >= vMinus
                  then Nothing
                  else Just $ vInit / (vMinus - vPlus)
  where vPlus  = e * pi * (d/2)^2
        vMinus = v
        vInit = pi * (d/2)^2 * h

main :: IO ()
main = do
  line <- getLine
  let [d,h,v,e] = map read (words line) :: [Float]
  let d' = d / 100 -- cm to m
      h' = h / 100 -- cm to m
      v' = v / (1000*1000) -- ml/s to m3/s
      e' = e / 100 -- cm/s to m/s
  case solve d' h' v' e' of
               Nothing -> putStrLn "NO"
               Just t  -> do
                 putStrLn "YES"
                 putStrLn (show t)

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

solve :: [Double] -> Maybe Double
solve [d, h, v, e] | pi / 4.0 * d * d * e > v = Nothing
                   | otherwise = Just ((pi / 4.0 * d * d * h) / (v - pi / 4.0 * d * d * e))

output :: Maybe Double -> IO()
output Nothing = putStrLn "No"
output (Just x) = putStrLn $ "Yes\n" ++ show x

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

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

main = do
  [d, h, v, e] <- fmap (map read . words) getLine
  maybe (putStrLn "NO") (\x -> putStrLn "YES" >> print x) (solve d h v e)

solve :: Double -> Double -> Double -> Double -> Maybe Double
solve d h v e | abs (v - e') > epsilon = Just $ (h*pi *(d/2)**2)/(v - e')
              | otherwise = Nothing
              where
                e' = e*pi*(d/2)**2
                epsilon = 10**(-7)

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

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

main = do
  [d, h, v, e] <- fmap (map read . words) getLine
  maybe (putStrLn "NO") (\x -> putStrLn "YES" >> print x) (solve d h v e)

solve :: Double -> Double -> Double -> Double -> Maybe Double
solve d h v e | v > e' = Just $ (pi *(d/2)**2)/(v - e')
              | otherwise = Nothing
              where
                e' = e*pi*(d/2)**2

solve::(Double, Double, Double, Double) -> String
solve (d,h,v,e) = do
		let a = e * d * pi / 4
		if v <= a then "NO" else "YES\n" ++ show ((h * d * pi/4)/(v - a))

main = getLine >>= (putStrLn . solve . getFour . map (\x -> read x :: Double) . words)
	where
		getFour (a : b : c : d : xz) = (a, b, c, d)

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

main=do
	 [d,h,v,e]<- map read.words <$> getLine::IO [Double]
	 if 3.14/4.0 *d*d *e >v then putStrLn "NO"
			      else do
					putStrLn "YES"
					print $  (3.14/4.0 *d*d *h) / (v-3.14/4.0 *d*d *e)


You are given $$$q$$$ queries in the following form:Given three integers $$$l_i$$$, $$$r_i$$$ and $$$d_i$$$, find minimum positive integer $$$x_i$$$ such that it is divisible by $$$d_i$$$ and it does not belong to the segment $$$[l_i, r_i]$$$.Can you answer all the queries?Recall that a number $$$x$$$ belongs to segment $$$[l, r]$$$ if $$$l \le x \le r$$$.

The first line contains one integer $$$q$$$ ($$$1 \le q \le 500$$$) — the number of queries. Then $$$q$$$ lines follow, each containing a query given in the format $$$l_i$$$ $$$r_i$$$ $$$d_i$$$ ($$$1 \le l_i \le r_i \le 10^9$$$, $$$1 \le d_i \le 10^9$$$). $$$l_i$$$, $$$r_i$$$ and $$$d_i$$$ are integers.

For each query print one integer: the answer to this query.

main = getContents >>= putStr . unlines . map answer . tail . lines

answer = show . solve . map read . words

solve [l,r,d]
    | l > d = d
    | otherwise = ((r + d) `div` d) * d

-- Educational Codeforces Round #58 (A), Contest 1101, Problem set ?.

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

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

main :: IO ()
main = do
  q <- read <$> getLine
  replicateM_ q $ do
    [l,r,d] <- map read . words <$> getLine
    print $ query l r d

query :: Int -> Int -> Int -> Int
query l r d
  | d < l     = d
  | otherwise = r + d - r `mod` d

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array

readInt :: String -> Int
readInt = Prelude.read

solve :: Int -> Int -> Int -> Int
solve l r d
    | d < l     = d
    | otherwise = ((r `div` d) + 1) * d

main :: IO ()
main = do
    q <- readInt <$> getLine
    replicateM_ q $ do
        [l, r, d] <- (map readInt . words) <$> getLine
        printf "%d\n" $ solve l r d

main = interact $ unlines . map (show . solve) . triplets . map read . tail . words
triplets (a:b:c:xs) = (a,b,c) : triplets xs
triplets [] = []
solve (l,r,d) | l > d = d
              | otherwise = (r + d) `div` d * d

main = do
    s <- getContents
    printSolution $ solve $ parse s

parse :: String -> [(Integer, Integer, Integer)]
parse s = f $ tail $ words s

f (l:r:d:v) = (read l, read r, read d):(f v)
f _ = []

solve :: [(Integer, Integer, Integer)] -> [Integer]
solve xs = map solveQuery xs

solveQuery (l, r, d) = if d < l then d else ((div r d) + 1) * d

printSolution (x:xs) = do
    print x
    printSolution xs
printSolution [] = return ()

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve l r d
    | d < l = d
    | otherwise = r `div` d * d + d

main = do
    [n] <- getInts
    ans <- forM [1..n] $ \i -> do
        [l, r, d] <- getInts
        return $ solve l r d

    mapM_ print ans


Hooray! Berl II, the king of Berland is making a knight tournament. The king has already sent the message to all knights in the kingdom and they in turn agreed to participate in this grand event.As for you, you're just a simple peasant. There's no surprise that you slept in this morning and were late for the tournament (it was a weekend, after all). Now you are really curious about the results of the tournament. This time the tournament in Berland went as follows:  There are n knights participating in the tournament. Each knight was assigned his unique number — an integer from 1 to n.  The tournament consisted of m fights, in the i-th fight the knights that were still in the game with numbers at least li and at most ri have fought for the right to continue taking part in the tournament.  After the i-th fight among all participants of the fight only one knight won — the knight number xi, he continued participating in the tournament. Other knights left the tournament.  The winner of the last (the m-th) fight (the knight number xm) became the winner of the tournament. You fished out all the information about the fights from your friends. Now for each knight you want to know the name of the knight he was conquered by. We think that the knight number b was conquered by the knight number a, if there was a fight with both of these knights present and the winner was the knight number a.Write the code that calculates for each knight, the name of the knight that beat him.

The first line contains two integers n, m (2 ≤ n ≤ 3·105; 1 ≤ m ≤ 3·105) — the number of knights and the number of fights. Each of the following m lines contains three integers li, ri, xi (1 ≤ li < ri ≤ n; li ≤ xi ≤ ri) — the description of the i-th fight. It is guaranteed that the input is correct and matches the problem statement. It is guaranteed that at least two knights took part in each battle.

Print n integers. If the i-th knight lost, then the i-th number should equal the number of the knight that beat the knight number i. If the i-th knight is the winner, then the i-th number must equal 0.

NoteConsider the first test case. Knights 1 and 2 fought the first fight and knight 1 won. Knights 1 and 3 fought the second fight and knight 3 won. The last fight was between knights 3 and 4, knight 4 won.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

parseLine = B.words >>> map readInt >>> (\[a,b,c] -> (a,b,c))

_3 (_,_,c) = c

main = do
    [n,m] <- readsInt
    l <- map parseLine . B.lines <$> B.getContents
    putStrLn $ unwords $ map show $ solve n l

solve :: Int -> [(Int,Int,Int)] -> [Int]
solve n l = go [] (S.fromList [1..n]) l
    where
    go !res !t [] = map snd $ sort $ (S.findMin t,0):res
    go !res !t ((l,r,x):qs) = go res' t' qs
        where
        t1 = snd $ S.split (l-1) t
        l1 = S.toList $ S.delete x $ fst $ S.split (r+1) t1
        t' = foldl' (\t y -> S.delete y t) t l1
        res' = foldl' (\ e y -> (y,x):e) res l1


You are given a permutation p of length n. Also you are given m foe pairs (ai, bi) (1 ≤ ai, bi ≤ n, ai ≠ bi). Your task is to count the number of different intervals (x, y) (1 ≤ x ≤ y ≤ n) that do not contain any foe pairs. So you shouldn't count intervals (x, y) that contain at least one foe pair in it (the positions and order of the values from the foe pair are not important).Consider some example: p = [1, 3, 2, 4] and foe pairs are {(3, 2), (4, 2)}. The interval (1, 3) is incorrect because it contains a foe pair (3, 2). The interval (1, 4) is also incorrect because it contains two foe pairs (3, 2) and (4, 2). But the interval (1, 2) is correct because it doesn't contain any foe pair.

The first line contains two integers n and m (1 ≤ n, m ≤ 3·105) — the length of the permutation p and the number of foe pairs. The second line contains n distinct integers pi (1 ≤ pi ≤ n) — the elements of the permutation p. Each of the next m lines contains two integers (ai, bi) (1 ≤ ai, bi ≤ n, ai ≠ bi) — the i-th foe pair. Note a foe pair can appear multiple times in the given list.

Print the only integer c — the number of different intervals (x, y) that does not contain any foe pairs. Note that the answer can be too large, so you should use 64-bit integer type to store it. In C++ you can use the long long integer type and in Java you can use long integer type.

NoteIn the first example the intervals from the answer are (1, 1), (1, 2), (2, 2), (3, 3) and (4, 4).

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Array (array, (!), elems, accumArray)
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, m] <- readInts
  ps <- readInts
  rs <- replicateM m readInts

  let
    a = array (1, n) $ zip ps [1..]

    l = scanl1 max $ elems $ accumArray max 0  (1, n) $ map (\[i, j] -> o (a!i, a!j)) rs
      where
        o (a, b) = if a <= b then (b, a) else (a, b)

  print $ sum $ map (\(i, l) -> fromIntegral (i-l) :: Int64) $ zip [1..] l

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Array (array, (!), elems, accumArray)
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, m] <- readInts
  ps <- readInts
  rs <- replicateM m readInts

  let
    a = array (1, n) $ zip ps [1..]

    l = scanl1 max $ elems $ accumArray max 0  (1, n) $ map (\[i, j] -> o (a!i, a!j)) rs
      where
        o (a, b) = if a <= b then (b, a) else (a, b)

  print $ sum $ map (\(i, l) -> i-l) $ zip [1..] l


Bob watches TV every day. He always sets the volume of his TV to $$$b$$$. However, today he is angry to find out someone has changed the volume to $$$a$$$. Of course, Bob has a remote control that can change the volume.There are six buttons ($$$-5, -2, -1, +1, +2, +5$$$) on the control, which in one press can either increase or decrease the current volume by $$$1$$$, $$$2$$$, or $$$5$$$. The volume can be arbitrarily large, but can never be negative. In other words, Bob cannot press the button if it causes the volume to be lower than $$$0$$$.As Bob is so angry, he wants to change the volume to $$$b$$$ using as few button presses as possible. However, he forgets how to do such simple calculations, so he asks you for help. Write a program that given $$$a$$$ and $$$b$$$, finds the minimum number of presses to change the TV volume from $$$a$$$ to $$$b$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$T$$$ ($$$1 \le T \le 1\,000$$$). Then the descriptions of the test cases follow. Each test case consists of one line containing two integers $$$a$$$ and $$$b$$$ ($$$0 \le a, b \le 10^{9}$$$) — the current volume and Bob's desired volume, respectively.

For each test case, output a single integer — the minimum number of presses to change the TV volume from $$$a$$$ to $$$b$$$. If Bob does not need to change the volume (i.e. $$$a=b$$$), then print $$$0$$$.

NoteIn the first example, Bob can press the $$$-2$$$ button twice to reach $$$0$$$. Note that Bob can not press $$$-5$$$ when the volume is $$$4$$$ since it will make the volume negative. In the second example, one of the optimal ways for Bob is to press the $$$+5$$$ twice, then press $$$-1$$$ once.In the last example, Bob can press the $$$+5$$$ once, then press $$$+1$$$.

    import Control.Monad
    import Data.List

    f :: Int -> Int
    f x
        |r == 0 = t
        |or [r == 4, r == 3] = t + 2
        |otherwise = t + 1
        where r = x `mod` 5
              t = x `div` 5

    main = do
        t <- readLn
        replicateM_ t $ do
            a <- fmap (sort . fmap read . words) getLine
            print $ f ((a !! 1) - (a !! 0))

import Control.Monad

solve :: [Int] -> Int
solve [x,y] = (d `div` 5) + e `div` 2 + e `mod` 2
  where
    d= abs (x-y)
    e=d `mod` 5

routine :: IO ()
routine = do
  l <- (map read.words) <$> getLine
  print $ solve l

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

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad(forM_, liftM, replicateM, replicateM_)

--import Debug.Trace
traceShowId :: a -> a
traceShowId = id

-- Input parsing
parseInts :: String -> [Int]
parseInts str = map read (words str)

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

parseIntsM :: IO [Int]
parseIntsM = parseInts <$> getLine

-- Solution

data State = State {
  dist :: Int,
  steps :: Int
}

step :: Int -> State -> State
step k s =
  let d = dist s in
    State (d `mod` k) (steps s + (d `div` k))

stepCount :: Int -> Int -> Int
stepCount a b = steps . (step 1) . (step 2) . (step 5) $ (State (abs (b - a)) 0)

taskM :: IO ()
taskM = do
  [a, b] <- parseIntsM
  print $ stepCount a b

main :: IO ()
main = do
  [t] <- parseIntsM
  replicateM_ t taskM

import Control.Monad ( replicateM_ )

main = do
  n <- readLn
  replicateM_ n $ do
    [x, y] <- fmap (fmap read . words) getLine
    let diff = abs $ x - y
        div5 = diff `div` 5
        rem1 = (diff - div5 * 5)
        div2 = rem1 `div` 2
        remain = rem1 - (div2 * 2)
    print $ div5 + div2 + remain

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

process (a:b:[]) | y==0 = x
                 | y<=2 = x+1
		 | otherwise = x+2
		where 	x= div (abs (a-b)) 5
                        y= mod (abs (a-b)) 5

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

process :: Int -> Int -> [Int] -> Int
process a b xs = sum $ zipWith div (scanr (flip mod) d (tail xs)) xs
    where d = abs (a-b)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    [a,b] <- fmap (map readInt.words) getLine
    print $ process a b [1,2,5]
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t


You are given a bracket sequence $$$s$$$ of length $$$n$$$, where $$$n$$$ is even (divisible by two). The string $$$s$$$ consists of $$$\frac{n}{2}$$$ opening brackets '(' and $$$\frac{n}{2}$$$ closing brackets ')'.In one move, you can choose exactly one bracket and move it to the beginning of the string or to the end of the string (i.e. you choose some index $$$i$$$, remove the $$$i$$$-th character of $$$s$$$ and insert it before or after all remaining characters of $$$s$$$).Your task is to find the minimum number of moves required to obtain regular bracket sequence from $$$s$$$. It can be proved that the answer always exists under the given constraints.Recall what the regular bracket sequence is:  "()" is regular bracket sequence;  if $$$s$$$ is regular bracket sequence then "(" + $$$s$$$ + ")" is regular bracket sequence;  if $$$s$$$ and $$$t$$$ are regular bracket sequences then $$$s$$$ + $$$t$$$ is regular bracket sequence. For example, "()()", "(())()", "(())" and "()" are regular bracket sequences, but ")(", "()(" and ")))" are not.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$2 \le n \le 50$$$) — the length of $$$s$$$. It is guaranteed that $$$n$$$ is even. The second line of the test case containg the string $$$s$$$ consisting of $$$\frac{n}{2}$$$ opening and $$$\frac{n}{2}$$$ closing brackets.

For each test case, print the answer — the minimum number of moves required to obtain regular bracket sequence from $$$s$$$. It can be proved that the answer always exists under the given constraints.

NoteIn the first test case of the example, it is sufficient to move the first bracket to the end of the string.In the third test case of the example, it is sufficient to move the last bracket to the beginning of the string.In the fourth test case of the example, we can choose last three openning brackets, move them to the beginning of the string and obtain "((()))(())".

import Control.Monad

type Test = String

getLines :: Int -> IO [Test]
getLines count = replicateM count getTest

getTest :: IO Test
getTest = do
    _ <- getLine
    line <- getLine
    return line

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = (process first 0 0 0) : getAnswer rest

process :: Test -> Integer -> Integer -> Integer -> Integer
process [] opened closed amount = 0
process (first:rest) opened closed amount = if first == '('
                                            then toAdd + process rest (opened + 1) closed (amount + add)
                                            else toAdd + process rest opened (closed + 1) (amount + add)
    where toAdd = if closed > opened && (closed - opened > amount)
                  then add
                  else 0
          add = if closed > opened && (closed - opened > amount)
                then closed - opened - amount
                else 0

main :: IO ()
main = do
    count <- getLine
    tests <- getLines (read count)
    mapM_ print (getAnswer tests)

import Control.Monad

f :: (Int,Int) -> Char -> (Int,Int)
f (ans,open) '(' = (ans,open+1)
f (ans,open) ')'
  | open > 0 = (ans,open-1)
  | otherwise = (ans+1,open)

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    getLine
    s <- getLine
    print . fst $ foldl f (0,0) s

bracketToNumber :: Char -> Int
bracketToNumber '(' = 1
bracketToNumber ')' = -1

solve :: String -> Int
solve = negate . minimum . scanl (+) 0 . map bracketToNumber

main :: IO ()
main = interact $ unlines . map show . map solve . map snd . filter (even . fst) . zip [1 .. ] . tail . lines

{-# OPTIONS -O2 #-}

import Control.Monad (replicateM_)
import Control.Monad.Writer

main = readLn >>= flip replicateM_ (getLine >> getLine >>= print . f)

f :: String -> Int
f = counter 0 where
    counter :: Int -> String -> Int
    counter _ [] = 0
    counter n (x:xs) = case x of
        '('         -> counter (n+1) xs
        ')' | n > 0 -> counter (n-1) xs
            | otherwise -> 1 + counter n (xs ++ ")")
        x           -> error $ "Strange character " ++ show x

import           Control.Monad (forM_, replicateM)

main = do
  t <- readLn
  bracketStrings <- replicateM t $ getLine >> getLine
  forM_ bracketStrings (\s -> print (snd (foldl (\(l, c) p -> if p == '('
                                                              then (l+1, c)
                                                              else if l == 0
                                                                   then (0, c+1)
                                                                   else (l-1, c)) (0, 0) s)))

import           Control.Monad (forM_, replicateM)

main = do
  t <- readLn
  replicateM t $ do
    getLine
    s <- getLine
    print $ snd $ foldl (\(l, c) p -> if p == '('
                                      then (l+1, c)
                                      else if l == 0
                                           then (0, c+1)
                                           else (l-1, c)) (0, 0) s

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_: l : rest) = (itoline . solve ) l : tcio rest
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: String -> Int
solve cs = maximum $ scanl (flip (\c-> if c==')' then (+1) else (subtract 1))) 0 cs

import Control.Monad

type Test = String

getLines :: Int -> IO [Test]
getLines count = replicateM count getTest

getTest :: IO Test
getTest = do
    _ <- getLine
    line <- getLine
    return line

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = (process first 0 0 0) : getAnswer rest

process :: Test -> Integer -> Integer -> Integer -> Integer
process [] opened closed amount = 0
process (first:rest) opened closed amount = if first == '('
                                            then toAdd + process rest (opened + 1) closed (amount + add)
                                            else toAdd + process rest opened (closed + 1) (amount + add)
    where toAdd = if closed > opened && (closed - opened > amount)
                  then add
                  else 0
          add = if closed > opened && (closed - opened > amount)
                then closed - opened - amount
                else 0

main :: IO ()
main = do
    count <- getLine
    tests <- getLines (read count)
    print (getAnswer tests)


A well-known art union called "Kalevich is Alive!" manufactures objects d'art (pictures). The union consists of n painters who decided to organize their work as follows.Each painter uses only the color that was assigned to him. The colors are distinct for all painters. Let's assume that the first painter uses color 1, the second one uses color 2, and so on. Each picture will contain all these n colors. Adding the j-th color to the i-th picture takes the j-th painter tij units of time.Order is important everywhere, so the painters' work is ordered by the following rules:  Each picture is first painted by the first painter, then by the second one, and so on. That is, after the j-th painter finishes working on the picture, it must go to the (j + 1)-th painter (if j < n);  each painter works on the pictures in some order: first, he paints the first picture, then he paints the second picture and so on;  each painter can simultaneously work on at most one picture. However, the painters don't need any time to have a rest;  as soon as the j-th painter finishes his part of working on the picture, the picture immediately becomes available to the next painter. Given that the painters start working at time 0, find for each picture the time when it is ready for sale.

The first line of the input contains integers m, n (1 ≤ m ≤ 50000, 1 ≤ n ≤ 5), where m is the number of pictures and n is the number of painters. Then follow the descriptions of the pictures, one per line. Each line contains n integers ti1, ti2, ..., tin (1 ≤ tij ≤ 1000), where tij is the time the j-th painter needs to work on the i-th picture.

Print the sequence of m integers r1, r2, ..., rm, where ri is the moment when the n-th painter stopped working on the i-th picture.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

gao :: [Int] -> [Int] -> [Int]
gao a b = let c = zipWith (+) b $ zipWith max a $ 0: c in c

main :: IO ()
main = do
  (m:n:_) <- getInts
  a <- replicateM m $ getInts
  let ans = tail . map last $ scanl gao (replicate n 0) a
  putStrLn $ unwords $ map show ans
  where
  getInts = map readInt . C.words <$> C.getLine

import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO()
main = putStrLn . unwords . map show . solve . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

solve :: [Int] -> [Int]
solve (n:m:a) = let b = transpose $ rect 0 [] a
                in solve' b (replicate n 0)
                where rect :: Int -> [Int] -> [Int] -> [[Int]]
                      rect _ l [] = [reverse l]
                      rect i l (a:s) | i == m = reverse l : rect 0 [] (a:s)
                                     | otherwise = rect (i + 1) (a:l) s

                      solve' :: [[Int]] -> [Int] -> [Int]
                      solve' s t = foldl (\ t l -> addTo (head t) l t) t s

                      addTo :: Int-> [Int] -> [Int] -> [Int]
                      addTo _ [] [] = []
                      addTo f (l:ls) (t:ts) = let nt = l + max f t
                                              in nt : addTo nt ls ts

import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO()
main = putStrLn . unwords . map show . solve . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

solve :: [Int] -> [Int]
solve (n:m:a) = let b = transpose $ rect 0 [] a
                in solve' b (replicate n 0)
                where rect :: Int -> [Int] -> [Int] -> [[Int]]
                      rect _ l [] = [reverse l]
                      rect i l (a:s) | i == m = reverse l : rect 0 [] (a:s)
                                     | otherwise = rect (i + 1) (a:l) s

                      solve' :: [[Int]] -> [Int] -> [Int]
                      solve' [] t = t
                      solve' (l:s) t = solve' s (addTo (head t) l t)

                      addTo :: Int-> [Int] -> [Int] -> [Int]
                      addTo _ [] [] = []
                      addTo f (l:ls) (t:ts) = let nt = l + max f t
                                              in nt : addTo nt ls ts

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
import Control.DeepSeq
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs
{-# INLINE slices #-}

main :: IO ()
main = do
  [m,n] <- map read.words <$> getLine
  xss <- slices n.map readInt.B.words <$> B.getContents
  putStr.unwords.map show $ solve $ transpose xss

solve :: [[Int]] -> [Int]
solve (xs:xss) = foldl' step (scanl1 (+) xs) xss
   where
     step :: [Int] -> [Int] -> [Int]
     step times ys = times`deepseq`go 0 times ys
      where
        go !time (t:times) (y:ys)
          | time <= t = (t+y)    : go (t+y)    times ys
          | otherwise = (time+y) : go (time+y) times ys
        go _ _ _ = []

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

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

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

gao :: [Int] -> [Int] -> [Int]
gao a b = let c = zipWith (+) b $ zipWith max a (0:c) in c

main :: IO ()
main = do
  [m,n] <- getInts
  arr <- replicateM m getInts
  let ans = tail . map last $ scanl gao (replicate n 0) arr
  putStrLn $ unwords $ map show ans


All techniques in the ninja world consist of hand seals. At the moment Naruto is learning a new technique, which consists of $$$n\cdot m$$$ different seals, denoted by distinct numbers. All of them were written in an $$$n\times m$$$ table.The table is lost now. Naruto managed to remember elements of each row from left to right, and elements of each column from top to bottom, but he doesn't remember the order of rows and columns. Please restore the table consistent with this data so that Naruto will be able to learn the new technique.

The first line of the input contains the only integer $$$t$$$ ($$$1\leq t\leq 100\,000$$$) denoting the number of test cases. Their descriptions follow. The first line of each test case description consists of two space-separated integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 500$$$) standing for the number of rows and columns in the table, respectively. All hand seals are encoded by the positive integers from $$$1$$$ to $$$n\cdot m$$$. The following $$$n$$$ lines contain $$$m$$$ space separated integers each, denoting elements of an arbitrary row in the table left to right. The following $$$m$$$ lines contain $$$n$$$ space separated integers each, denoting elements of an arbitrary column in the table top to bottom. Sum of $$$nm$$$ over all test cases does not exceed $$$250\,000$$$. It is guaranteed that each row occurs in the input exactly once, as well as each column. It is also guaranteed that each number from $$$1$$$ to $$$nm$$$ occurs exactly once in all rows, as well as in all columns. Finally, it is guaranteed that a table consistent with the input exists.

For each test case, output $$$n$$$ lines with $$$m$$$ space-separated integers each, denoting the restored table. One can show that the answer is always unique.

NoteConsider the first test case. The matrix is $$$2 \times 3$$$. You are given the rows and columns in arbitrary order.One of the rows is $$$[6, 5, 4]$$$. One of the rows is $$$[1, 2, 3]$$$.One of the columns is $$$[1, 6]$$$. One of the columns is $$$[2, 5]$$$. One of the columns is $$$[3, 4]$$$.You are to reconstruct the matrix. The answer is given in the output.

import Data.Foldable
import Data.Function
import Data.List
import Data.Maybe
import Data.Traversable

getLineOfInts :: IO [Int]
getLineOfInts = do
  line <- getLine
  let ints = read <$> words line :: [Int]
  return ints

putLineOfInts :: [Int] -> IO ()
putLineOfInts xs =
  putStrLn $ unwords $ (show <$> xs)

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

  for_ [1..t] $ \_ -> do
    [n, m] <- getLineOfInts

    rows <- for [1..n] $ \_ -> getLineOfInts
    cols <- for [1..m] $ \_ -> getLineOfInts

    let memberOfFirstCol = head $ head rows
    let firstCol = fromJust $ find (memberOfFirstCol `elem`) cols

    let rowIndex r = fromJust $ elemIndex (head r) firstCol
    let indexedRows = (\r -> (rowIndex r, r)) <$> rows

    let sortedIndexedRows = sortBy (compare `on` fst) indexedRows

    for sortedIndexedRows $ \(_, r) -> putLineOfInts r

{-# LANGUAGE BlockArguments, BangPatterns, LambdaCase, TypeApplications #-}

import Prelude
import Data.List as L
import Data.Maybe
import Data.Functor
import Data.Foldable
import Data.Bifunctor
import Data.Function
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 as B
import Control.Arrow

main :: IO ()
main = do
  n <- readLn
  replicateM_ n do
    [n, m] <- fmap int . B.words <$> B.getLine
    rows <- replicateM n $ (id &&& Set.fromList) . fmap int . B.words <$> B.getLine
    c : cols <- replicateM m $ fmap int . B.words <$> B.getLine
    B.putStr $ B.unlines $ fmap (B.unwords . fmap (B.pack . show)) $ fmap (`selectContaining` rows) c
  where
    selectContaining n = fst . fromJust . L.find (Set.member n . snd)

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a


Two players A and B have a list of $$$n$$$ integers each. They both want to maximize the subtraction between their score and their opponent's score. In one turn, a player can either add to his score any element from his list (assuming his list is not empty), the element is removed from the list afterward. Or remove an element from his opponent's list (assuming his opponent's list is not empty).Note, that in case there are equal elements in the list only one of them will be affected in the operations above. For example, if there are elements $$$\{1, 2, 2, 3\}$$$ in a list and you decided to choose $$$2$$$ for the next turn, only a single instance of $$$2$$$ will be deleted (and added to the score, if necessary). The player A starts the game and the game stops when both lists are empty. Find the difference between A's score and B's score at the end of the game, if both of the players are playing optimally.Optimal play between two players means that both players choose the best possible strategy to achieve the best possible outcome for themselves. In this problem, it means that each player, each time makes a move, which maximizes the final difference between his score and his opponent's score, knowing that the opponent is doing the same.

The first line of input contains an integer $$$n$$$ ($$$1 \le n \le 100\,000$$$) — the sizes of the list. The second line contains $$$n$$$ integers $$$a_i$$$ ($$$1 \le a_i \le 10^6$$$), describing the list of the player A, who starts the game. The third line contains $$$n$$$ integers $$$b_i$$$ ($$$1 \le b_i \le 10^6$$$), describing the list of the player B.

Output the difference between A's score and B's score ($$$A-B$$$) if both of them are playing optimally.

NoteIn the first example, the game could have gone as follows:   A removes $$$5$$$ from B's list.  B removes $$$4$$$ from A's list.  A takes his $$$1$$$.  B takes his $$$1$$$. Hence, A's score is $$$1$$$, B's score is $$$1$$$ and difference is $$$0$$$.There is also another optimal way of playing:  A removes $$$5$$$ from B's list.  B removes $$$4$$$ from A's list.  A removes $$$1$$$ from B's list.  B removes $$$1$$$ from A's list. The difference in the scores is still $$$0$$$.In the second example, irrespective of the moves the players make, they will end up with the same number of numbers added to their score, so the difference will be $$$0$$$.

import Control.Applicative
import Data.List

main = do
  n <- readLn :: IO Int
  as <- reverse . sort . map read . words <$> getLine :: IO [Integer]
  bs <- reverse . sort . map read . words <$> getLine :: IO [Integer]

  let (x,y) = foldl (\(a,b) (c,d) -> (a+c,b+d)) (0,0) (solve 0 as bs)
  print $ x - y

solve _ [] [] = []
solve t [] (b:bs) = if t == 0 then solve 1 [] bs else (0,b) : solve 0 [] bs
solve t (a:as) [] = if t == 0 then (a,0) : solve 1 as [] else solve 0 as []
solve t (a:as) (b:bs)
  | t == 0 = if a > b then (a,0) : solve 1 as (b:bs) else solve 1 (a:as) bs
  | t == 1 = if a < b then (0,b) : solve 0 (a:as) bs else solve 0 as (b:bs)

{-# LANGUAGE ViewPatterns #-}
module Main where
import Data.List
import Data.Int

default (Int)
main = interact exec
exec = show . uncurry solve . (\(n:xs) -> splitAt n xs) . map read . words
solve (rsort -> xs) (rsort -> ys) = play (0 :: Int64) (0 :: Int64) xs ys
play a b [] [] = a - b
play a b (x:xs) [] = play b (a +. x) [] xs
play a b [] (_:ys) = play b a ys []
play a b xxs@(x:xs) yys@(y:ys)
  | x >= y = play b (a +. x) yys xs
  | x < y  = play b a       ys  xxs
rsort = sortBy (flip compare)

a +. b = a + fromIntegral b

import Control.Applicative
import Data.List

main = do
  n <- readLn :: IO Int
  as <- reverse . sort . map read . words <$> getLine :: IO [Int]
  bs <- reverse . sort . map read . words <$> getLine :: IO [Int]

  let (x,y) = foldl (\(a,b) (c,d) -> (a+c,b+d)) (0,0) (solve 0 as bs)
  print $ x - y

solve _ [] [] = []
solve t [] (b:bs) = if t == 0 then solve 1 [] bs else (0,b) : solve 0 [] bs
solve t (a:as) [] = if t == 0 then (a,0) : solve 1 as [] else solve 0 as []
solve t (a:as) (b:bs)
  | t == 0 = if a > b then (a,0) : solve 1 as (b:bs) else solve 1 (a:as) bs
  | t == 1 = if a < b then (0,b) : solve 0 (a:as) bs else solve 0 as (b:bs)

{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction #-}
module Main where
import Data.Int
import Control.Applicative
default (Int64)
main = interact exec
exec = show . solve . tail . map read . words
solve = runFold ((\s p n m -> if p && n then s else s - 2 * m) <$> premap abs sumf <*> anyf (>= 0) <*> anyf (<= 0) <*> premap abs minf)
sumf = Fold (+) 0 id
anyf f = Fold (\a x -> a || f x) False id
minf = Fold min maxBound id

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin
premap f (Fold step begin done) = Fold step' begin done
  where
    step' x a = step x (f a)


You are given a rooted tree with n vertices. In each leaf vertex there's a single integer — the number of apples in this vertex. The weight of a subtree is the sum of all numbers in this subtree leaves. For instance, the weight of a subtree that corresponds to some leaf is the number written in the leaf.A tree is balanced if for every vertex v of the tree all its subtrees, corresponding to the children of vertex v, are of equal weight. Count the minimum number of apples that you need to remove from the tree (specifically, from some of its leaves) in order to make the tree balanced. Notice that you can always achieve the goal by just removing all apples.

The first line contains integer n (2 ≤ n ≤ 105), showing the number of vertices in the tree. The next line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 108), ai is the number of apples in the vertex number i. The number of apples in non-leaf vertices is guaranteed to be zero.  Then follow n - 1 lines, describing the tree edges. Each line contains a pair of integers xi, yi (1 ≤ xi, yi ≤ n, xi ≠ yi) — the vertices connected by an edge.  The vertices are indexed from 1 to n. Vertex 1 is the root.

Print a single integer — the minimum number of apples to remove in order to make the tree balanced. Please, do not write the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the sin, cout streams cin, cout or the %I64d specifier.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = B.interact $ B.words >>> map readInt >>> process

process :: [Int] -> B.ByteString
process l = B.pack .(++"\n") .show $ solve n as es
    where
    n:l1 = l
    (as,l2) = splitAt n l1
    es = takeByTwo l2 []

takeByTwo [] !acc = acc
takeByTwo (a:b:l) !acc = takeByTwo l ((a,b):acc)

solve :: Int -> [Int] -> [(Int,Int)] -> Int64
solve n as es = s - (snd $ go (-1) 1)
    where
    memo :: Array Int [Int]
    memo = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    as' :: UArray Int Int
    as' = listArray (1,n) as
    s = foldl' (\a b -> a + fromIntegral b) 0 as
    go :: Int -> Int -> (Int64,Int64)
    go pre v | null vs = (1,fromIntegral (as' ! v))
             | otherwise = (r*l,r*k*l)
        where
        vs = delete pre $ memo ! v
        res = map (go v) vs
        r = foldl1 lcm (map fst res)
        limit = minimum $ map snd res
        k = if r == 0 then 0 else limit `div` r
        l = fromIntegral $ length vs

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = B.interact $ B.words >>> map readInt >>> process

process :: [Int] -> B.ByteString
process l = B.pack .(++"\n") .show $ solve n as es
    where
    n:l1 = l
    (as,l2) = splitAt n l1
    es = takeByTwo l2 []

takeByTwo [] !acc = acc
takeByTwo (a:b:l) !acc = takeByTwo l ((a,b):acc)

solve :: Int -> [Int] -> [(Int,Int)] -> Int64
solve n as es = s - (snd $ go (-1) 1)
    where
    memo :: Array Int [Int]
    memo = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    as' :: UArray Int Int
    as' = listArray (1,n) as
    s = foldl' (\a b -> a + fromIntegral b) 0 as
    go :: Int -> Int -> (Int64,Int64)
    go pre v | null vs = (1,fromIntegral (as' ! v))
             | otherwise = (r*k,r*k* fromIntegral (length vs))
        where
        vs = delete pre $ memo ! v
        res = map (go v) vs
        r = foldl1 lcm (map fst res)
        limit = minimum $ map snd res
        k = if r == 0 then 0 else limit `div` r

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = B.interact $ B.words >>> map readInt >>> process

process :: [Int] -> B.ByteString
process l = B.pack .(++"\n") .show $ solve n as es
    where
    n:l1 = l
    (as,l2) = splitAt n l1
    es = takeByTwo l2 []

takeByTwo [] !acc = acc
takeByTwo (a:b:l) !acc = takeByTwo l ((a,b):acc)

solve :: Int -> [Int] -> [(Int,Int)] -> Int64
solve n as es = s - (snd $ go (-1) 1)
    where
    memo :: Array Int [Int]
    memo = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    as' :: UArray Int Int
    as' = listArray (1,n) as
    s = foldl' (\a b -> a + fromIntegral b) 0 as
    go :: Int -> Int -> (Int64,Int64)
    go pre v | null vs = (1,fromIntegral (as' ! v))
             | otherwise = (r,r*k* fromIntegral (length vs))
        where
        vs = delete pre $ memo ! v
        res = map (go v) vs
        r = foldl1 lcm (map fst res)
        limit = minimum $ map snd res
        k = limit `div` r


There are $$$n$$$ left boots and $$$n$$$ right boots. Each boot has a color which is denoted as a lowercase Latin letter or a question mark ('?'). Thus, you are given two strings $$$l$$$ and $$$r$$$, both of length $$$n$$$. The character $$$l_i$$$ stands for the color of the $$$i$$$-th left boot and the character $$$r_i$$$ stands for the color of the $$$i$$$-th right boot.A lowercase Latin letter denotes a specific color, but the question mark ('?') denotes an indefinite color. Two specific colors are compatible if they are exactly the same. An indefinite color is compatible with any (specific or indefinite) color.For example, the following pairs of colors are compatible: ('f', 'f'), ('?', 'z'), ('a', '?') and ('?', '?'). The following pairs of colors are not compatible: ('f', 'g') and ('a', 'z').Compute the maximum number of pairs of boots such that there is one left and one right boot in a pair and their colors are compatible.Print the maximum number of such pairs and the pairs themselves. A boot can be part of at most one pair.

The first line contains $$$n$$$ ($$$1 \le n \le 150000$$$), denoting the number of boots for each leg (i.e. the number of left boots and the number of right boots). The second line contains the string $$$l$$$ of length $$$n$$$. It contains only lowercase Latin letters or question marks. The $$$i$$$-th character stands for the color of the $$$i$$$-th left boot. The third line contains the string $$$r$$$ of length $$$n$$$. It contains only lowercase Latin letters or question marks. The $$$i$$$-th character stands for the color of the $$$i$$$-th right boot.

Print $$$k$$$ — the maximum number of compatible left-right pairs of boots, i.e. pairs consisting of one left and one right boot which have compatible colors. The following $$$k$$$ lines should contain pairs $$$a_j, b_j$$$ ($$$1 \le a_j, b_j \le n$$$). The $$$j$$$-th of these lines should contain the index $$$a_j$$$ of the left boot in the $$$j$$$-th pair and index $$$b_j$$$ of the right boot in the $$$j$$$-th pair. All the numbers $$$a_j$$$ should be distinct (unique), all the numbers $$$b_j$$$ should be distinct (unique). If there are many optimal answers, print any of them.

{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Array

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

c :: Char -> Int
c '?' = 0
c x = ord x - 96

cvt :: C.ByteString -> Array Int [Int]
cvt !s = accumArray ins [] (0, 26) $ (`zip` [1 .. ]) $ map c $ C.unpack s
  where
    ins e a = a : e

merge a b = l `seq` (zip a b, drop l a, drop l b)
  where
    l = min (length a) (length b)

solve :: [C.ByteString] -> Builder
solve (sn:x:y:l) = intDec (length res) <> char7 '\n' <> (mconcat $ map enc res)
  where
    n = ri $ C.takeWhile isDigit sn
    a = cvt $ C.take n x
    b = cvt $ C.take n y
    res = loop 1 [] (a ! 0) (b ! 0)
    enc (u, v) = intDec u <> char7 ' ' <> intDec v <> char7 '\n'
    loop i r u v
      | i > 26 = let (r', u', v') = merge u v in concat (r' : r)
      | otherwise = loop (succ i) (d : d0 : d1 : r) u' v'
      where
        ai = a ! i
        bi = b ! i
        (d, ai', bi') = merge ai bi
        (d0, ai'', v') = merge ai' v
        (d1, u', bi'') = merge u bi'

main :: IO ()
main = hPutBuilder stdout . solve . C.lines =<< C.getContents

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

type ColourMap = Map.Map Char [Int]

zipWithRemainder :: [a] -> [b] -> ([(a, b)], [a], [b])
zipWithRemainder a b = helper a b []
  where helper (ah:at) (bh:bt) acc = helper at bt ((ah,bh):acc)
        helper a b acc = (acc, a, b)

query q map = Map.findWithDefault [] q map

getColourMap :: String -> ColourMap
getColourMap inp = Map.fromListWith (++) $ zip inp (map return [1..])

stage1 :: ColourMap -> ColourMap -> ([(Int, Int)], ColourMap, ColourMap)
stage1 a b = helper (Map.keys a) (Map.keys b) a b []
  where helper [] _ a b acc = (acc, a, b)
        helper _ [] a b acc = (acc, a, b)
        helper ak@(ah:at) bk@(bh:bt) a b acc
          | ah < bh || ah == '?'  = helper at bk a b acc
          | ah > bh || bh == '?'  = helper ak bt a b acc
          | otherwise =
             let
               (pairs, newa, newb) = zipWithRemainder (query ah a) (query bh b)
             in
               helper at bt (Map.insert ah newa a) (Map.insert bh newb b) (pairs ++ acc)

stage2 :: ([(Int, Int)], ColourMap, ColourMap) -> ([(Int, Int)], ColourMap, ColourMap)
stage2 arg = (helperB. helperA) arg
  where
    helperA (acc, a, b) = let
        aWild = query '?' a
        pairWild [] _ b acc = ([], b, acc)
        pairWild wilds [] b acc = (wilds, b, acc)
        pairWild wilds ('?':bt) b acc = pairWild wilds bt b acc
        pairWild wilds (bh:bt) b acc =
          let
            (pairs, newWilds, newb) = zipWithRemainder wilds (query bh b)
          in
            pairWild newWilds bt (Map.insert bh newb b) (pairs ++ acc)
        (newWild, newB, newAcc) = pairWild aWild (Map.keys b) b []
      in
        (newAcc ++ acc, Map.insert '?' newWild a, newB)
    helperB (acc, a, b) =
      let
        inv (a, b) = (b, a)
        (pairs, nb, na) = helperA ([], b, a)
      in
        ((map inv pairs) ++ acc, na, nb)

stage3 (acc, a, b) = acc ++ zip (query '?' a) (query '?' b)

main = do
  n <- getLine
  a <- getLine
  b <- getLine
  let sol = (stage3 . stage2) $ stage1 (getColourMap a) (getColourMap b)
  putStrLn . show $ length sol
  let showPair (a, b) = (show a) ++ (' ' : show b)
  mapM_ (putStrLn . showPair) sol


Andrewid the Android is a galaxy-famous detective. He is now investigating a case of frauds who make fake copies of the famous Stolp's gears, puzzles that are as famous as the Rubik's cube once was.Its most important components are a button and a line of n similar gears. Each gear has n teeth containing all numbers from 0 to n - 1 in the counter-clockwise order. When you push a button, the first gear rotates clockwise, then the second gear rotates counter-clockwise, the the third gear rotates clockwise an so on.Besides, each gear has exactly one active tooth. When a gear turns, a new active tooth is the one following after the current active tooth according to the direction of the rotation. For example, if n = 5, and the active tooth is the one containing number 0, then clockwise rotation makes the tooth with number 1 active, or the counter-clockwise rotating makes the tooth number 4 active.Andrewid remembers that the real puzzle has the following property: you can push the button multiple times in such a way that in the end the numbers on the active teeth of the gears from first to last form sequence 0, 1, 2, ..., n - 1. Write a program that determines whether the given puzzle is real or fake.

The first line contains integer n (1 ≤ n ≤ 1000) — the number of gears. The second line contains n digits a1, a2, ..., an (0 ≤ ai ≤ n - 1) — the sequence of active teeth: the active tooth of the i-th gear contains number ai.

In a single line print "Yes" (without the quotes), if the given Stolp's gears puzzle is real, and "No" (without the quotes) otherwise.

NoteIn the first sample test when you push the button for the first time, the sequence of active teeth will be 2 2 1, when you push it for the second time, you get 0 1 2.

import Control.Applicative

solve :: Int -> [Int] -> Bool
solve n list@(x:xs) = and . zipWith (\y (i,z) -> ((y+z) `mod` n) == i) list . zip [0..n-1] $ cycle [n-x,x]

main :: IO ()
main = do
  n <- readLn
  xs <- map read . words <$> getLine
  putStrLn $ if solve n xs == True
    then "Yes"
    else "No"

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

solve :: [Int] -> String
solve (n:a) = solve' 0
    where
        solve' :: Int -> String
        solve' m | m == n           = "No"
                 | check a m 0 True = "Yes"
                 | otherwise        = solve' (m+1)

        check :: [Int] -> Int -> Int -> Bool -> Bool
        check []     _ _ _ = True
        check (a:ax) s i add | add && (rem (a+s) n) == i   = check ax s (i+1) False
                             | (not add) && (rem (a-s+n) n) == i = check ax s (i+1) True
                             | otherwise = False

-- http://codeforces.com/problemset/problem/556B.hs

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

createGears :: Int -> [Int] -> [[Int]]
createGears n active = createGears' True active
	where
		createGears' _ [] = []
		createGears' isOdd (a:as)
			| isOdd = (drop a $ cycle [0..(n-1)]) : createGears' (not isOdd) as
			| otherwise = (drop (n-a-1) $ cycle [(n-1),(n-2)..0]) : createGears' (not isOdd) as

checkGears :: Int -> [[Int]] -> Bool
checkGears 0 _ = False
checkGears n gears
	| sequenced = True
	| otherwise = checkGears (n-1) (pushButton gears)
	where
		sequenced = isSequence $ map head gears
		pushButton xs = map (drop 1) $ xs

isSequence :: (Enum a, Eq a) => [a] -> Bool
isSequence [] = True
isSequence (x:[]) = True
isSequence (x:y:zs)
	| y == succ x = isSequence $ y:zs
	| otherwise = False

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

main = do

	n <- fmap read $ getLine :: IO Int
	active <- fmap (map read) $ fmap words $ getLine :: IO [Int]

	let
		valid = checkGears n $ createGears n active

	case valid of
		True -> putStrLn "Yes"
		False -> putStrLn "No"

import Data.List

main = getContents >>= putStrLn . (\b -> if b then "Yes" else "No") . solve . map read . tail . words

solve :: [Int] -> Bool
solve xs = foldl1 (||) [solve' xs i | i <- [1..length xs]]

solve' xs i = let ys = go xs i (length xs) in ys == [0..length xs-1]

go [] _ _ = []
go (x:xs) i n = mod (x + i) n : go xs (n - i) n

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

f :: [Integer] -> Integer -> Bool -> [Integer]
f [] _ _ = []
f (x:xs) n b
    | b = (x+n) : f xs n (not b)
    | otherwise = (x-n) : f xs n (not b)

main = do
    n <- getLine
    tab <- readInts
    let d = head tab in
        putStrLn $ if (map (flip mod $ read n) $ f tab d False) == (take (read n) [0..])
            then "Yes"
            else "No"

f :: Int -> [Int] -> Bool
f n (x:xs) = let k = (n-x) `mod` n
             in check n k 1 xs

check :: Int -> Int -> Int -> [Int] -> Bool
check _ _ _ [] = True
check n k i (x:xs) | odd i = (if x >= k then x - k else n - (k - x)) == i && check n k (i+1) xs
                   | even i = (x + k) `mod` n == i && check n k (i+1) xs

main = do
    n <- fmap read getLine
    xs <- fmap (map read . words) getLine
    putStrLn $ if f n xs then "Yes"
                         else "No"

import Data.List (group)

probB line = if (length . group) b == 1 then "Yes" else "No"
    where a = map read $ words line :: [Int]
          n = length a
          f x y = if even y then y - x else x - y
          b = map ((`mod` n ).(+ n)) $ zipWith f a [0..]

main = do
    _ <- getLine
    line <- getLine
    putStrLn $ probB line

probB line = if loop (n + 1) a then "Yes" else "No"
    where
        a = map read $ words line :: [Int]
        n = length a
        f x y = (x + y + n) `mod` n
        loop (-1) _ = False
        loop _ a | foldr (&&) True $ zipWith (==) a [0..n-1] = True
        loop k a = loop (k-1) $ zipWith f a $ cycle [1, -1]

main = do
    _ <- getLine
    line <- getLine
    putStrLn $ probB line

module Main where

parse x = (takeWhile (/=' ') x) : if (null rest) then [] else parse (tail $ (dropWhile (/=' ')) x) where
    rest = dropWhile (/=' ') x

read'::String->Int
read'=read
isOk :: Int -> [Int] -> Bool
isOk n [] = True
isOk n [x] = True
isOk n (x:y:z) = mod (x + y) n == 0 && isOk n (y:z)

word True = "Yes"
word False = "No"

main = do
    s1 <- getLine
    s2 <- getLine
    putStr $ word $ isOk (read s1) $ map (`mod` (read s1)) $ zipWith (-) [0..(read s1)-1] (map read' $ parse s2)

bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True  = t

parse :: String -> [Int]
parse contents = map read (words a)
                 where [_, a] = lines contents

solve :: [Int] -> Bool
solve a = any isPermutation . take n . iterate rotate $ a
          where n             = length a
                isPermutation = (== [0..n - 1])
                rotate        = zipWith plus (cycle [1, n - 1])
                x `plus` y    = (x + y) `rem` n

main :: IO ()
main = putStrLn . bool "No" "Yes" . solve . parse =<< getContents

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

solve xs@(x:_) n =
  (zipWith (\a b -> (a + b * x) `mod` n) xs (cycle [-1, 1])) == [0..(n-1)]

main = do
  n <- readInt <$> getLine
  xs <- map readInt . words <$> getLine
  putStrLn (if solve xs n then "Yes" else "No")

import Data.List (sort)

bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True  = t

parse :: String -> [Int]
parse contents = map read (words a)
                 where [_, a] = lines contents

solve :: [Int] -> Bool
solve a = any (isPermutation . rotation) [0..n - 1]
          where n             = length a
                isPermutation = (== [0..n - 1]) . sort
                rotate   d    = (`rem` n) . (+ d)
                rotation d    = zipWith rotate (cycle [d, d * (n - 1)]) a

main :: IO ()
main = putStrLn . bool "No" "Yes" . solve . parse =<< getContents

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

solve x xs n =
  (zipWith (\a b -> (a + b * x) `mod` n) xs (cycle [-1, 1])) == [0..(n-1)]

main = do
  n <- readInt <$> getLine
  (x:xs) <- map readInt . words <$> getLine
  putStrLn (if solve x xs n then "Yes" else "No")


Andre has very specific tastes. Recently he started falling in love with arrays.Andre calls an nonempty array $$$b$$$ good, if sum of its elements is divisible by the length of this array. For example, array $$$[2, 3, 1]$$$ is good, as sum of its elements — $$$6$$$ — is divisible by $$$3$$$, but array $$$[1, 1, 2, 3]$$$ isn't good, as $$$7$$$ isn't divisible by $$$4$$$. Andre calls an array $$$a$$$ of length $$$n$$$ perfect if the following conditions hold:   Every nonempty subarray of this array is good.  For every $$$i$$$ ($$$1 \le i \le n$$$), $$$1 \leq a_i \leq 100$$$. Given a positive integer $$$n$$$, output any perfect array of length $$$n$$$. We can show that for the given constraints such an array always exists.An array $$$c$$$ is a subarray of an array $$$d$$$ if $$$c$$$ can be obtained from $$$d$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first and only line of every test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$).

For every test, output any perfect array of length $$$n$$$ on a separate line.

NoteArray $$$[19, 33]$$$ is perfect as all $$$3$$$ its subarrays: $$$[19]$$$, $$$[33]$$$, $$$[19, 33]$$$, have sums divisible by their lengths, and therefore are good.

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
  words >>> drop 1 >>> map (read >>> solve >>> map show >>> unwords) >>> unlines

solve :: Int -> [Int]
solve n = replicate n 1


C*++ language is quite similar to C++. The similarity manifests itself in the fact that the programs written in C*++ sometimes behave unpredictably and lead to absolutely unexpected effects. For example, let's imagine an arithmetic expression in C*++ that looks like this (expression is the main term):  expression ::= summand | expression + summand | expression - summand  summand ::= increment | coefficient*increment  increment ::= a++ | ++a  coefficient ::= 0|1|2|...|1000 For example, "5*a++-3*++a+a++" is a valid expression in C*++.Thus, we have a sum consisting of several summands divided by signs "+" or "-". Every summand is an expression "a++" or "++a" multiplied by some integer coefficient. If the coefficient is omitted, it is suggested being equal to 1.The calculation of such sum in C*++ goes the following way. First all the summands are calculated one after another, then they are summed by the usual arithmetic rules. If the summand contains "a++", then during the calculation first the value of the "a" variable is multiplied by the coefficient, then value of "a" is increased by 1. If the summand contains "++a", then the actions on it are performed in the reverse order: first "a" is increased by 1, then — multiplied by the coefficient.The summands may be calculated in any order, that's why sometimes the result of the calculation is completely unpredictable! Your task is to find its largest possible value.

The first input line contains an integer a ( - 1000 ≤ a ≤ 1000) — the initial value of the variable "a". The next line contains an expression in C*++ language of the described type. The number of the summands in the expression does not exceed 1000. It is guaranteed that the line describing the expression contains no spaces and tabulation.

Output a single number — the maximal possible value of the expression.

NoteConsider the second example. Initially a = 3. Suppose that at first the first summand is calculated, and then the second one is. The first summand gets equal to 3, and the value of a is increased by 1. At the calculation of the second summand a is increased once more (gets equal to 5). The value of the second summand is 5, and together they give 8. If we calculate the second summand first and the first summand later, then the both summands equals to 4, and the result is 8, too.

import Data.List
import Data.Ord (comparing)

type Summand = (Int, Int)

readExpression::[Char]->Int->[Summand]
readExpression [] _ = []
readExpression (x:xs) 0  = let
				z = if (x=='-')	then (-1) else 1
				in readExpression xs z
readExpression t z = let
						(s,t1) = readSummand t z
						all = readExpression t1 0
					in (s:all)

readSummand::[Char]->Int->(Summand, [Char])
readSummand (x:xs) z | '0'<=x && x<='9' = let
							(k,t1) = readCoefficient (read [x]) xs
							(i,t2) = readIncrement t1
							zk = z*k
							in ((zk,i),t2)

readSummand t z = let
							(i,t1) = readIncrement t
							in ((z,i),t1)

readIncrement::[Char]->(Int, [Char])
readIncrement ('+':'+':'a':xs) = (1,xs)
readIncrement ('a':'+':'+':xs) = (0,xs)

readCoefficient::Int->[Char]->(Int, [Char])
readCoefficient k ('*':xs) = (k, xs)
readCoefficient k (x:xs) = readCoefficient (10*k + (read [x])) xs

sortSummands::[Summand]->[Summand]
sortSummands xs = sortBy cmpCoeff xs
	where cmpCoeff = comparing fst

calc::Int->[Summand]->Int
calc _ [] = 0
calc a ((c,i):xs) = let
					a' = if (i==1) then (a+1) else a
					s = c * a'
					in s + (calc (a+1) xs)

calc2::[Char]->[Summand]->Int
calc2 s x = calc (read s) x

main = do
	a <- getLine
	x <- getLine
	putStrLn (show (calc2 a (sortSummands (readExpression x 1))))

import List
main = interact f
f input = output where
  [init,expr] = lines input
  output = show $ cal (read init::Int) $ sort $ coef ("+":(summ $ incr expr))
  incr [] = []
  incr ('a':'+':'+':xs) = 'b':(incr xs)
  incr ('+':'+':'a':xs) = 'c':(incr xs)
  incr (x:xs) = x:(incr xs)
  summ [] = []
  summ xs = if null y then [x] else x:[head y]:(summ $ tail y)
    where (x,y) = break (\x -> x=='+' || x=='-') xs
  coef [] = []
  coef (x:y:xs) = ((if x=="+" then 1 else -1) * c,d):(coef xs)
    where
      (v,w) = break (=='*') y
      c = read (if null w then "1" else v) :: Int
      d = if null w then v else (tail w)
  cal x [] = 0
  cal x ((y,z):xs) = (if z=="b" then y*x else y*(x+1)) + (cal (x+1) xs)


A sequence $$$a_1, a_2, \dots, a_n$$$ is called good if, for each element $$$a_i$$$, there exists an element $$$a_j$$$ ($$$i \ne j$$$) such that $$$a_i+a_j$$$ is a power of two (that is, $$$2^d$$$ for some non-negative integer $$$d$$$).For example, the following sequences are good:  $$$[5, 3, 11]$$$ (for example, for $$$a_1=5$$$ we can choose $$$a_2=3$$$. Note that their sum is a power of two. Similarly, such an element can be found for $$$a_2$$$ and $$$a_3$$$),  $$$[1, 1, 1, 1023]$$$,  $$$[7, 39, 89, 25, 89]$$$,  $$$[]$$$. Note that, by definition, an empty sequence (with a length of $$$0$$$) is good.For example, the following sequences are not good:  $$$[16]$$$ (for $$$a_1=16$$$, it is impossible to find another element $$$a_j$$$ such that their sum is a power of two),  $$$[4, 16]$$$ (for $$$a_1=4$$$, it is impossible to find another element $$$a_j$$$ such that their sum is a power of two),  $$$[1, 3, 2, 8, 8, 8]$$$ (for $$$a_3=2$$$, it is impossible to find another element $$$a_j$$$ such that their sum is a power of two). You are given a sequence $$$a_1, a_2, \dots, a_n$$$. What is the minimum number of elements you need to remove to make it good? You can delete an arbitrary set of elements.

The first line contains the integer $$$n$$$ ($$$1 \le n \le 120000$$$) — the length of the given sequence. The second line contains the sequence of integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$).

Print the minimum number of elements needed to be removed from the given sequence in order to make it good. It is possible that you need to delete all $$$n$$$ elements, make it empty, and thus get a good sequence.

NoteIn the first example, it is enough to delete one element $$$a_4=5$$$. The remaining elements form the sequence $$$[4, 7, 1, 4, 9]$$$, which is good.

import qualified Data.Map.Strict as Map

toint s = (read s) :: Integer

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

doit :: [Integer] -> (Map.Map Integer Integer) -> [Integer] -> Integer
doit [] s p = 0
doit (x:xs) s p =
	let ss = quitar x s in
	if any (\t -> (Map.findWithDefault 0 (t-x) ss) > 0) p then
		doit xs s p
	else
		1 + (doit xs s p)

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

solve::String -> String
solve ss =
	let x = Prelude.map toint (tail (words ss)) in
	let s = asdasd x in
	let p = Prelude.map (\x -> 2^x) [0..30] in
	let r = doit x s p in
	(show r) ++ "\n"

main = do
  interact $ solve

import qualified Data.IntMap.Strict as IntMap

main = interact $ pureMain

pureMain :: String -> String
pureMain s = show $ length $ filter (== False) $ map f a
  where
    [[n], a] = map (map read . words) $ lines s
    m = foldr (\ k -> IntMap.insertWith (+) k 1) IntMap.empty a
    f n = or $ map (\ x -> if n == x then m IntMap.! x > 1 else IntMap.member x m) [2^i - n | i <- [0..31]]

import qualified Data.IntSet as IntSet

main = interact $ pureMain

pureMain :: String -> String
pureMain s = show $ length $ filter (== False) $ map f a
  where
    [[n], a] = map (map read . words) $ lines s
    set = IntSet.fromList a
    f n = or $ map (\ x -> IntSet.member x set) [2^i - n | i <- [0..31], 2^i - n /= n]