There are $$$n$$$ houses numbered from $$$1$$$ to $$$n$$$ on a circle. For each $$$1 \leq i \leq n - 1$$$, house $$$i$$$ and house $$$i + 1$$$ are neighbours; additionally, house $$$n$$$ and house $$$1$$$ are also neighbours.Initially, $$$m$$$ of these $$$n$$$ houses are infected by a deadly virus. Each morning, Cirno can choose a house which is uninfected and protect the house from being infected permanently.Every day, the following things happen in order:  Cirno chooses an uninfected house, and protect it permanently.  All uninfected, unprotected houses which have at least one infected neighbor become infected. Cirno wants to stop the virus from spreading. Find the minimum number of houses that will be infected in the end, if she optimally choose the houses to protect.Note that every day Cirno always chooses a house to protect before the virus spreads. Also, a protected house will not be infected forever.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Description of test cases follows. The first line of each test case consists of two positive integers $$$n, m$$$ ($$$5 \leq n \leq 10^9$$$, $$$1 \leq m \leq \min(n, 10^5)$$$) — the number of houses on the circle, and the number of houses that are initially infected.  The second line of each test case consists of $$$m$$$ distinct positive integers $$$a_1, a_2, \cdots , a_m$$$ ($$$1 \leq a_i \leq n$$$) — the indices of the houses infected initially. It is guaranteed that the sum of $$$m$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, output an integer on a separate line, which is the minimum number of infected houses in the end.

NoteIn the first test case:At the start of the first day, house $$$3$$$, $$$6$$$, $$$8$$$ are infected. Choose house $$$2$$$ to protect.At the start of the second day, house $$$3$$$, $$$4$$$, $$$5$$$, $$$6$$$, $$$7$$$, $$$8$$$, $$$9$$$ are infected. Choose house $$$10$$$ to protect.At the start of the third day, no more houses are infected.In the second test case:At the start of the first day, house $$$2$$$, $$$5$$$ are infected. Choose house $$$1$$$ to protect.At the start of the second day, house $$$2$$$, $$$3$$$, $$$4$$$, $$$5$$$, $$$6$$$ are infected. No more available houses can be protected.

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

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( elemIndex
                                                , findIndex
                                                , foldl'
                                                , sort
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

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

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

-- makeBaseFunctor ''Tree

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

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

-- >>> y x
-- 6

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

-- >>> z x
-- 11

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

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

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

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

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

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

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

-- >>> f1 fibSeq
-- 88

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

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

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

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

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, m] <- readChar8'
        xs     <- sort <$> readChar8'
        let d = sum $ max 1 . subtract 1 <$> takeWhile
                (> 0)
                (zipWith (\x y -> x - y * 4) (reverse (sort ((head xs + n - last xs - 1) : zipWith (\x y -> x - y - 1) (tail xs) xs))) [0 ..])
        print $ n - d


Ayush and Ashish play a game on an unrooted tree consisting of $$$n$$$ nodes numbered $$$1$$$ to $$$n$$$. Players make the following move in turns:   Select any leaf node in the tree and remove it together with any edge which has this node as one of its endpoints. A leaf node is a node with degree less than or equal to $$$1$$$. A tree is a connected undirected graph without cycles.There is a special node numbered $$$x$$$. The player who removes this node wins the game. Ayush moves first. Determine the winner of the game if each player plays optimally.

The first line of the input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10)$$$ — the number of testcases. The description of the test cases follows. The first line of each testcase contains two integers $$$n$$$ and $$$x$$$ $$$(1\leq n \leq 1000, 1 \leq x \leq n)$$$ — the number of nodes in the tree and the special node respectively. Each of the next $$$n-1$$$ lines contain two integers $$$u$$$, $$$v$$$ $$$(1 \leq u, v \leq n, \text{ } u \ne v)$$$, meaning that there is an edge between nodes $$$u$$$ and $$$v$$$ in the tree.

For every test case, if Ayush wins the game, print "Ayush", otherwise print "Ashish" (without quotes).

NoteFor the $$$1$$$st test case, Ayush can only remove node $$$2$$$ or $$$3$$$, after which node $$$1$$$ becomes a leaf node and Ashish can remove it in his turn.For the $$$2$$$nd test case, Ayush can remove node $$$2$$$ in the first move itself.

import Data.Graph
import Data.Tuple
import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
  [n,x] <- (map read.words) <$> getLine
  es <- replicateM (n-1) $ ((map read.words) <$> getLine)
  putStrLn $ if solve n x es then "Ayush" else "Ashish"

solve :: Int -> Int -> [[Int]] -> Bool
solve n x es = (trivial tr) || (even n)
  where
    tr = toTree x n es

trivial :: Tree Int -> Bool
trivial (Node _ trs) = (length trs) < 2

toTree :: Int -> Int ->  [[Int]] -> Tree Int
toTree x n ps =head $ dfs gr [x]
  where
    tups = map (\[a,b] -> (a,b)) ps
    gr = buildG (1,n) (tups++map swap tups)

import Control.Monad

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

solve :: IO()
solve = do
  [n,x] <- map read.words <$> getLine
  es <- replicateM (n-1) $ (map read.words <$> getLine)
  putStrLn (winner n x es)

winner :: Int -> Int -> [[Int]] -> String
winner n x es = do
  let degreeX = length (filter (isXEdge x) es)
  if degreeX <= 1 || even n then "Ayush" else "Ashish"

isXEdge :: Int -> [Int] -> Bool
isXEdge x [u,v] = u == x || v == x

{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:x:rest0   ->
            let (vals, rest1) = splitAt (2*(n-1)) rest0
                count = sum $ (\a -> if a == x then 1 else 0) <$> vals
                subres = if count <= 1 || n `mod` 2 == 0 then "Ayush" else "Ashish"
            in Just (subres, rest1)
        ) tokens
  sequence_ $ putStrLn <$> res

import Control.Monad

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

solve :: IO()
solve = do
  [n,x] <- map read.words <$> getLine
  es <- replicateM (n-1) $ (map read.words <$> getLine)
  putStrLn (winner n x es)

winner :: Int -> Int -> [[Int]] -> String
winner n x es = do
  let degreeX = length (filter (isXEdge x) es)
  if degreeX <= 1 || odd degreeX then "Ayush" else "Ashish"

isXEdge :: Int -> [Int] -> Bool
isXEdge x [u,v] = u == x || v == x

{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:x:rest0   ->
            let (vals, rest1) = splitAt (2*(n-1)) rest0
                count = sum $ (\a -> if a == x then 1 else 0) <$> vals
                subres = if count == 1 || n `mod` 2 == 0 then "Ayush" else "Ashish"
            in Just (subres, rest1)
        ) tokens
  sequence_ $ putStrLn <$> res


Petya has n integers: 1, 2, 3, ..., n. He wants to split these integers in two non-empty groups in such a way that the absolute difference of sums of integers in each group is as small as possible. Help Petya to split the integers. Each of n integers should be exactly in one group.

The first line contains a single integer n (2 ≤ n ≤ 60 000) — the number of integers Petya has.

Print the smallest possible absolute difference in the first line. In the second line print the size of the first group, followed by the integers in that group. You can print these integers in arbitrary order. If there are multiple answers, print any of them.

NoteIn the first example you have to put integers 1 and 4 in the first group, and 2 and 3 in the second. This way the sum in each group is 5, and the absolute difference is 0.In the second example there are only two integers, and since both groups should be non-empty, you have to put one integer in the first group and one in the second. This way the absolute difference of sums of integers in each group is 1.

module Main where

import Data.Int
import Data.Bits
import Control.Applicative

is2Pow :: (Num a, Bits a) => a -> Bool
is2Pow n = (n .&. (n - 1)) == 0

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

prefixSums :: (Num a) => [a] -> [a]
prefixSums = scanl (+) 0

solve :: Int64 -> (Int64, [Int64])
solve n = (rsum - lsum, notPows ++ pows)
    where sum = n * (n + 1) `div` 2
          lsum = sum `div` 2
          rsum = sum - lsum

          all = filter (not . is2Pow) $ [1 .. n]
          candidates = takeWhile (<= lsum) $ prefixSums all

          notPows = take (length candidates - 1) all
          pows = decompose (lsum - last candidates)

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Integer]] -> [String]
sol [[n]] = let
    t = div (n*(n+1)) 2
    diff = fromBool (t`mod`2 == 1) :: Integer
    res = sol' n (t`div`2)
  in [show diff , intercalate " " $ map show ((fromIntegral $ length res):res) ]

sol' :: Integer -> Integer -> [Integer]
sol' n w
  | w == 0 = []
  | n < w  = n : (sol' (n-1) (w-n))
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Integer]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

module Main where

import Data.Int
import Data.Bits
import Control.Applicative

is2Pow :: (Num a, Bits a) => a -> Bool
is2Pow n = (n .&. (n - 1)) == 0

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

prefixSums :: (Num a) => [a] -> [a]
prefixSums = scanl (+) 0

solve :: Int64 -> (Int64, [Int64])
solve n = (rsum - lsum, take (length candidates) all ++ decompose (lsum - last candidates))
    where sum = n * (n + 1) `div` 2
          lsum = sum `div` 2
          rsum = sum - lsum

          all = filter (not . is2Pow) $ [1 .. n]
          candidates = takeWhile (<= lsum) $ prefixSums all

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

module Main where

import Data.Int
import Control.Applicative

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

solve :: Int64 -> (Int64, [Int64])
solve n | even sum = (0, decompose (sum `div` 2))
        | otherwise = (2, decompose (sum `div` 2))
    where sum = n * (n + 1) `div` 2

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

module Main where

import Data.Int
import Control.Applicative

decompose :: Int64 -> [Int64]
decompose = go 1
    where go bit 0 = []
          go bit n | odd n = bit : bits
                   | otherwise = bits
                   where n' = n `div` 2
                         bits = go (2 * bit) (n `div` 2)

solve :: Int64 -> (Int64, [Int64])
solve n | even sum = (0, decompose (sum `div` 2))
        | otherwise = (1, decompose (sum `div` 2))
    where sum = n * (n + 1) `div` 2

main :: IO ()
main = do
  n <- read <$> getLine
  let (diff, vs) = solve n
  print diff
  putStrLn . unwords $ map show (fromIntegral (length vs) : vs)

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n]] = let
    diff = fromBool (n == 1 || n`mod`2 == 0) :: Int
    res = sol' n ((n*(n+1))`div`4)
  in [ show diff , intercalate " " $ map show (length res:res) ]

sol' n w
  | w == 0 = []
  | n < w  = n : sol' (n-1) (w-n)
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n]] = let
    t = div (n*(n+1)) 2
    diff = fromBool (n == 1 || t`mod`2 == 1) :: Int
    res = sol' n (t`div`2)
  in [ show diff , intercalate " " $ map show (length res:res) ]

sol' n w
  | w == 0 = []
  | n < w  = n : sol' (n-1) (w-n)
  | n >= w = [w]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------


Nian is a monster which lives deep in the oceans. Once a year, it shows up on the land, devouring livestock and even people. In order to keep the monster away, people fill their villages with red colour, light, and cracking noise, all of which frighten the monster out of coming.Little Tommy has n lanterns and Big Banban has m lanterns. Tommy's lanterns have brightness a1, a2, ..., an, and Banban's have brightness b1, b2, ..., bm respectively.Tommy intends to hide one of his lanterns, then Banban picks one of Tommy's non-hidden lanterns and one of his own lanterns to form a pair. The pair's brightness will be the product of the brightness of two lanterns.Tommy wants to make the product as small as possible, while Banban tries to make it as large as possible.You are asked to find the brightness of the chosen pair if both of them choose optimally.

The first line contains two space-separated integers n and m (2 ≤ n, m ≤ 50). The second line contains n space-separated integers a1, a2, ..., an. The third line contains m space-separated integers b1, b2, ..., bm. All the integers range from  - 109 to 109.

Print a single integer — the brightness of the chosen pair.

NoteIn the first example, Tommy will hide 20 and Banban will choose 18 from Tommy and 14 from himself.In the second example, Tommy will hide 3 and Banban will choose 2 from Tommy and 1 from himself.

module Main where

import Control.Monad
import Data.List

getNumberList :: String -> [Int]
getNumberList str = map read (words str)

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

compareFst :: Ord a => (a, b) -> (a, b) -> Ordering
compareFst (v, _) (v', _) = compare v v'

main :: IO ()
main = do
    lengths <- getNumberList <$> getLine
    guard $ length lengths == 2

    let [n1, n2] = lengths

    list1 <- getIntegerList <$> getLine
    guard $ length list1 == n1

    list2 <- getIntegerList <$> getLine
    guard $ length list2 == n2

    let min1 = minimum list1
    let max1 = if n1 > 1 then maximum list1 else 0
    let min1' = if n1 > 2 then minimum . delete min1 $ list1 else 0
    let max1' = if n1 > 3 then maximum . delete max1 $ list1 else 0

    let extr1 = [min1, min1', max1, max1']
    let extr2 = [minimum list2, if n2 > 1 then maximum list2 else 0]

    let list3 = (\a b -> (a*b, a)) <$> extr1 <*> extr2

    let list4 = (*) <$> delete (snd (maximumBy compareFst list3)) extr1 <*> extr2

    print . maximum $ list4

    --return ()

module Main where

import Control.Monad
import Data.List

getNumberList :: String -> [Int]
getNumberList str = map read (words str)

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

compareSnd :: Ord b => (a, b) -> (a, b) -> Ordering
compareSnd (_, v) (_, v') = compare v v'

main :: IO ()
main = do
    lengths <- getNumberList <$> getLine
    guard $ length lengths == 2

    let [n1, n2] = lengths

    list1 <- getIntegerList <$> getLine
    guard $ length list1 == n1

    list2 <- getIntegerList <$> getLine
    guard $ length list2 == n2

    let min1 = minimum list1
    let max1 = if n1 > 1 then maximum list1 else 0
    let min1' = if n1 > 2 then minimum . delete min1 $ list1 else 0
    let max1' = if n1 > 3 then maximum . delete max1 $ list1 else 0

    let extr1 = [min1, min1', max1, max1']
    let extr2 = [minimum list2, if n2 > 1 then maximum list2 else 0]

    let list3 = (\a b -> (a*b, a)) <$> extr1 <*> extr2

    print . maximum $ (*) <$> delete (snd (maximumBy compareSnd list3)) extr1 <*> extr2

    --return ()


In this task you need to process a set of stock exchange orders and use them to create order book.An order is an instruction of some participant to buy or sell stocks on stock exchange. The order number i has price pi, direction di — buy or sell, and integer qi. This means that the participant is ready to buy or sell qi stocks at price pi for one stock. A value qi is also known as a volume of an order.All orders with the same price p and direction d are merged into one aggregated order with price p and direction d. The volume of such order is a sum of volumes of the initial orders.An order book is a list of aggregated orders, the first part of which contains sell orders sorted by price in descending order, the second contains buy orders also sorted by price in descending order.An order book of depth s contains s best aggregated orders for each direction. A buy order is better if it has higher price and a sell order is better if it has lower price. If there are less than s aggregated orders for some direction then all of them will be in the final order book.You are given n stock exhange orders. Your task is to print order book of depth s for these orders.

The input starts with two positive integers n and s (1 ≤ n ≤ 1000, 1 ≤ s ≤ 50), the number of orders and the book depth. Next n lines contains a letter di (either 'B' or 'S'), an integer pi (0 ≤ pi ≤ 105) and an integer qi (1 ≤ qi ≤ 104) — direction, price and volume respectively. The letter 'B' means buy, 'S' means sell. The price of any sell order is higher than the price of any buy order.

Print no more than 2s lines with aggregated orders from order book of depth s. The output format for orders should be the same as in input.

NoteDenote (x, y) an order with price x and volume y. There are 3 aggregated buy orders (10, 3), (20, 4), (25, 10) and two sell orders (50, 8), (40, 1) in the sample.You need to print no more than two best orders for each direction, so you shouldn't print the order (10 3) having the worst price among buy orders.

import qualified Data.Map as M
main=interact $ solve . lines
solve (ns:x) =  concatMap (f "S") (reverse sell) ++ concatMap (f "B") buy
                where [n,s] = map read $ words ns
                      merge [] m1 m2 = [M.toAscList m1, M.toDescList m2]
                      merge (x:xs) m1 m2 = let t = head x
                                               [k,v] = map read $ words $ drop 2 x
                                               f k new old = new + old
                                           in if t=='S' then merge xs (M.insertWithKey f k v m1) m2 else merge xs m1 $ M.insertWithKey f k v m2
                      [sell,buy] = map (\x->take (min s $ length x) x) $ merge x M.empty M.empty
                      f c x = c ++ " " ++ (show $ fst x) ++ " " ++ (show $ snd x) ++ "\n"

import qualified Data.IntMap.Strict as I
import Control.Monad

main :: IO()
main = do
	[n,k] <- fmap (map (\x -> read x::Int) .words) getLine
	(b,s) <- solve n I.empty I.empty
	let a1 = take k (I.toList s)
	    a2 = take k (reverse (I.toList b))
	forM_ (reverse a1) $ \(i,j) -> do {putStrLn ("S " ++ (show i) ++ " " ++ (show j))}
	forM_ a2 $ \(i,j) -> do {putStrLn ("B " ++ (show i) ++ " " ++ (show j))}

solve :: Int -> I.IntMap Int -> I.IntMap Int -> IO (I.IntMap Int,I.IntMap Int)
solve 0 m1 m2 = return (m1,m2)
solve x b s = do
	[d,p',q'] <- fmap words getLine
	let p = read p' :: Int
	    q = read q' :: Int
	case d of
		"B" -> if I.lookup p b == Nothing then solve  (x-1) (I.insert p q b) s else solve (x-1) (I.update (\x -> return (x+q)) p b) s
		"S" -> if I.lookup p s == Nothing then solve (x-1) b (I.insert p q s) else solve (x-1) b (I.update (\x -> return (x+q)) p s)

-- Codeforces 572B

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

main :: IO ()
main = do
    [n, s] <- fmap (map read . words) getLine :: IO [Int]
    replicateM n getLine >>= putStrLn . solve s . map words

solve :: Int -> [[String]] -> String
solve s book = foldl (\acc a -> (acc++a++"\n")) "" $ (reverse $ take s $ reverse slist) ++ (take s blist) where
    [slist, blist] = map (\c -> map (\ss -> c ++ " " ++ (ss!!0!!1) ++ " " ++ (show (foldl (\acc k -> acc + (read (k!!2) :: Int)) 0 ss))) $ groupBy (\a b -> (a!!1)==(b!!1)) $ sortBy (\a b -> compare (read (b!!1) :: Int) (read (a!!1) :: Int)) $ filter (\x -> (x!!0) == c) book) ["S", "B"]

import Data.List (sort)

data ReqType = Buy | Sell
    deriving (Eq, Ord)
data Request = Request {reqType :: ReqType, price :: Int, amount :: Int}
    deriving (Eq, Ord)

unite :: Request -> Request -> Request
unite (Request t p q1) (Request _ _ q2) = Request t p (q1+q2)

canUnite :: Request -> Request -> Bool
canUnite (Request t1 p1 _) (Request t2 p2 _) = t1 == t2 && p1 == p2

readReq :: String -> Request
readReq s | c == "B" = Request Buy p q
          | c == "S" = Request Sell p q
    where [c,p',q'] = words s
          p = read p'
          q = read q'

writeReq :: Request -> String
writeReq (Request t p q) = unwords [case t of
                                        Sell -> "S"
                                        Buy -> "B",
                                    show p, show q]

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

main = do
    [n,s] <- getList
    xs <- mapM (\_ -> fmap readReq getLine) [1..n]
    let ys = solve s xs
    mapM_ (putStrLn . writeReq) ys

solve :: Int -> [Request] -> [Request]
solve s = (\(a,b) -> reverse (take s (reverse a)) ++ take s b) . span ((==Sell) . reqType) . reverse . f . sort
    where f [] = []
          f [x] = [x]
          f (x:y:ys) = if canUnite x y then f ((unite x y):ys)
                                       else x : f (y:ys)

import Control.Monad
import Data.List
import Data.Ord

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose (st:stocks) 0 c = []
choose [] _ _ = []
choose (st:stocks) s c
  | fst3 st == c = st:choose stocks (s-1) c
  | otherwise = []

work sortedStocks s = choose sortedStocks s 'S' ++ choose (reverse sortedStocks) s 'B'

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

-- Codeforces 572B

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

main :: IO ()
main = do
    [n, s] <- fmap (map read . words) getLine :: IO [Int]
    replicateM n getLine >>= putStrLn . solve s . map words

solve :: Int -> [[String]] -> String
solve s book = foldl (\acc a -> (acc++a++"\n")) "" $ concatMap (\c -> take s $ map (\ss -> c ++ " " ++ (ss!!0!!1) ++ " " ++ (show (foldl (\acc k -> acc + (read (k!!2) :: Int)) 0 ss))) $ groupBy (\a b -> (a!!1)==(b!!1)) $ reverse $ sortBy (\a b -> compare (read (a!!1) :: Int) (read (b!!1) :: Int)) $ filter (\x -> (x!!0) == c) book) ["S", "B"]

import Control.Monad
import Data.List
import Data.Ord

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s - 1)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy (flip cmp) stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

import Control.Monad
import Data.List
import Data.Ord

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)

import Control.Monad
import Data.List
import Data.Ord

fst3 (x,_,_) = x
snd3 (_,x,_) = x
third3 (_,_,x) = x

readOneStock = do
  input <- getLine
  let strs = words input
  return (((strs !! 0)!!0), read (strs !! 1)::Int, read (strs !! 2)::Int)

cmp::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp a b
  | fst3 a == fst3 b = comparing snd3 a b
  | otherwise = comparing fst3 a b

cmp2::(Char,Int,Int) -> (Char,Int,Int) -> Ordering
cmp2 a b
  | fst3 a == fst3 b = comparing snd3 a b
  | fst3 a < fst3 b = GT
  | fst3 a > fst3 b = LT

gp::(Char,Int,Int) -> (Char,Int,Int) -> Bool
gp a b
  | fst3 a == fst3 b && snd3 a == snd3 b = True
  | otherwise = False

display [] = do
  putStrLn ""
display (s:ss) = do
  putStrLn (fst3 s : " " ++ show(snd3 s) ++ " " ++ show(third3 s))
  display ss

choose stocks 0 l = []
choose stocks s l = [stocks !! (s-1)] ++ choose stocks (s-1) l ++ [stocks !! (l - s)]

work sortedStocks s
  | 2*s <= l = choose sortedStocks s l
  | otherwise = sortedStocks
  where l = length sortedStocks

mergeHelper::[(Char,Int,Int)]->Int
mergeHelper [] = 0
mergeHelper (x:xs) = third3 x + mergeHelper xs

merge::[(Char,Int,Int)]->(Char,Int,Int)
merge xs = (fst3 x, snd3 x, mergeHelper xs)
  where x = xs !! 0

main = do
  input <- getLine
  let [n,s] = [read x::Int|x <- words input]
  stocks <- replicateM n readOneStock
  let sortedStocks = [merge x | x <- groupBy gp (sortBy cmp2 stocks)]
  print sortedStocks
  let ans = work sortedStocks s
  display(sortBy (flip cmp) ans)


As we all know, Winnie-the-Pooh just adores honey. Ones he and the Piglet found out that the Rabbit has recently gotten hold of an impressive amount of this sweet and healthy snack. As you may guess, Winnie and the Piglet asked to come at the Rabbit's place. Thus, there are n jars of honey lined up in front of Winnie-the-Pooh, jar number i contains ai kilos of honey. Winnie-the-Pooh eats the honey like that: each time he chooses a jar containing most honey. If the jar has less that k kilos of honey or if Winnie-the-Pooh has already eaten from it three times, he gives the jar to Piglet. Otherwise he eats exactly k kilos of honey from the jar and puts it back. Winnie does so until he gives all jars to the Piglet. Count how much honey Piglet will overall get after Winnie satisfies his hunger.

The first line contains two integers n and k (1 ≤ n ≤ 100, 1 ≤ k ≤ 100). The second line contains n integers a1, a2, ..., an, separated by spaces (1 ≤ ai ≤ 100).

Print a single number — how many kilos of honey gets Piglet.

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, k] = map read . words . head $ input
	let js = map read . words $ input !! 1
	let f x
		| x >= k * 3 = x - k * 3
		| otherwise = x `mod` k
	writeFile "output.txt" . show . sum . map f $ js

gao[[n,k],xs] = show.sum.map (\x -> if x < (3*k) then x `mod` k else x - (3*k)) $  xs
main = readFile "input.txt" >>= writeFile "output.txt" . gao . map (map read. words) . lines

import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        writeFile "output.txt" (show (solve xs k 0))

solve [] k sum = sum
solve (x:xs) k sum = if x >= 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))

import IO

solve :: Int -> [Int] -> Int
solve k xs  =  foldl (+) 0 (map f xs)
  where
    f x
      | x >= 3*k  =  x - 3*k
      | otherwise  =  mod x k

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

    [n, k]  <-  hGetLine hInput >>= return . map read . words
    xs  <-  hGetLine hInput >>= return . map read . words
    hPutStrLn hOutput (show $ solve k xs)

    hClose hOutput
    hClose hInput

solve [[_, k], xs] = show $ foldr f 0 xs
    where f a b = b + a - k * ((a `div` k) `min` 3)

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

gao[[n,k],xs] = show.sum.map (\x -> if x < 9 then x `mod` 3 else x - 9) $  xs
main = readFile "input.txt" >>= writeFile "output.txt" . gao . map (map read. words) . lines

import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        print (solve xs k 0)

solve [] k sum = sum
solve (x:xs) k sum = if x >= 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))

import System.Environment

main =
     do str1 <- readFile "input.txt"
        let l = map read (words str1)
        let (k:xs) = drop 1 l
        print (solve xs k 0)

solve [] k sum = sum
solve (x:xs) k sum = if x > 3*k then (solve xs k (sum + x-3*k)) else (solve xs k (sum + (x `mod` k)))


An undirected graph is called k-regular, if the degrees of all its vertices are equal k. An edge of a connected graph is called a bridge, if after removing it the graph is being split into two connected components.Build a connected undirected k-regular graph containing at least one bridge, or else state that such graph doesn't exist.

The single line of the input contains integer k (1 ≤ k ≤ 100) — the required degree of the vertices of the regular graph.

Print "NO" (without quotes), if such graph doesn't exist.  Otherwise, print "YES" in the first line and the description of any suitable graph in the next lines. The description of the made graph must start with numbers n and m — the number of vertices and edges respectively.  Each of the next m lines must contain two integers, a and b (1 ≤ a, b ≤ n, a ≠ b), that mean that there is an edge connecting the vertices a and b. A graph shouldn't contain multiple edges and edges that lead from a vertex to itself. A graph must be connected, the degrees of all vertices of the graph must be equal k. At least one edge of the graph must be a bridge. You can print the edges of the graph in any order. You can print the ends of each edge in any order. The constructed graph must contain at most 106 vertices and 106 edges (it is guaranteed that if at least one graph that meets the requirements exists, then there also exists the graph with at most 106 vertices and at most 106 edges).

NoteIn the sample from the statement there is a suitable graph consisting of two vertices, connected by a single edge.

data Edge = Edge Int Int
data Graph = Graph [Edge]

instance Show Edge where
    show (Edge a b) = (show a) ++ " " ++ (show b)

instance Show Graph where
    show (Graph [])     = ""
    show (Graph (e:es)) = (show e) ++ "\n" ++ (show (Graph es))

main :: IO()
main = putStrLn . solve . read =<< getLine

solve :: Int -> String
solve k | even k    = "NO"
        | k == 1    = "YES\n2 1\n1 2"
        | otherwise = "YES\n" ++ (show (k + k + 4)) ++ " " ++ (show (k * (k + 2))) ++ "\n" ++ (show (genGraph k))

genGraph :: Int -> Graph
genGraph k = Graph ([(Edge 1 (k + 3))] ++ (genSub 1 (k + 2)) ++ (genSub (k + 3) (k + k + 4)))

genSub :: Int -> Int -> [Edge]
genSub a b = (genOut (a + 1)) ++ (genIn (a + 2) (a + 1))
    where
        genOut :: Int -> [Edge]
        genOut c | c > b - 2 = []
                 | otherwise  = ((Edge a c):(genOut (c + 1)))

        genIn :: Int -> Int -> [Edge]
        genIn c d | c >= b && d >= b = []
                  | d >= c = genIn (c + 1) (a + 1)
                  | even (c - a) && c == d + 1 && c <= b - 2 = genIn (c + 1) (a + 1)
                  | otherwise = ((Edge d c):(genIn c (d + 1)))

import Debug.Trace (trace)
import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2) ++ [(1, 1 + n1)])
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 2 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

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

import Control.Monad (guard)
import Data.List (delete)

type Edge  = (Int, Int)
type Graph = [Edge]

vertices :: Graph -> Int
vertices = maximum . map (\(a, b) -> max a b)

merge :: Graph -> Graph -> Graph
merge g g' = g ++ (map (\(a, b) -> (a + n, b + n)) g')
             where n = vertices g

-- deg(v_1) = deg(v_2) = ... = deg(v_{d + 1}) = d - 1
almostClique :: Int -> Graph
almostClique d = do i <- [0    ..d]
                    j <- delete (i + (d + 1) `div` 2) [i + 1..d]
                    return (1 + i, 1 + j)

-- deg(v_1) = d - 1, deg(v_2) = deg(v_3) = ... = deg(v_{d + 2}) = d
almostRegular :: Int -> Graph
almostRegular d = (almostClique d) ++ [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve d
    | even d    = Nothing
    | d == 1    = Just $ [(1, 2)]
    | otherwise = Just $ (1, 1 + n) : merge g g
    where g = almostRegular d
          n = vertices g

format :: Maybe Graph -> String
format Nothing  = "NO"
format (Just g) = unlines $ "YES" : map pp ((vertices g, length g) : g)
                  where pp (a, b) = unwords . map show $ [a, b]

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

solve :: Int -> String
solve 1 = "YES\n2 1\n1 2\n" -- special case
solve n | even n  = "NO\n" -- parity argument on each side of bridge
solve n = let
  size = 2*n+4
  edgeCount = quot (n*size) 2
  edgeList = concat [[(x,y),(x+n+2, y+n+2)]
                     | x <- [1..n], y <- [x+1 .. n+1], quot x 2 /= quot y 2]
          ++ concat [[(x, n+2), (x+n+2, 2*n+4)] | x <- [2..n]]
          ++ [(n+2, 2*n+4)]
  dispEdge (x, y) = show x ++ " " ++ show y ++ "\n"
  in "YES\n" ++ concatMap dispEdge ((size, edgeCount) : edgeList)

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

import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2))
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 1 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

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

import Data.List (sort)

data Graph = Graph Int [(Int, Int)]
             deriving (Show)

connect :: Graph -> Graph -> Graph
connect (Graph n1 e1) (Graph n2 e2) = Graph (n1 + n2) (e1 ++ (map shift e2))
                                      where shift (a, b) = (n1 + a, n1 + b)

recur :: Int -> [(Int, Int)]
recur 0 = []
recur d = (recur (d - 2)) ++ [(i, d - 1) | i <- [1..d - 2]] ++ [(i, d) | i <- [1..d - 2]]

construct :: Int -> Graph
construct d = Graph (d + 2) (baseEdges ++ extraEdges)
              where baseEdges  = recur (d + 1)
                    extraEdges = [(i, d + 2) | i <- [2..d + 1]]

solve :: Int -> Maybe Graph
solve 1 = Just (Graph 2 [(1, 2)])
solve d = if   even d
          then Nothing
          else Just (connect g g)
          where g = construct d

format :: Maybe Graph -> String
format Nothing                = "NO"
format (Just (Graph n edges)) = "YES\n" ++ (show n) ++ " " ++ (show (length edges)) ++ "\n" ++ (unlines . map showEdge $ edges)
                                where showEdge (a, b) = (show a) ++ " " ++ (show b)

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


There are famous Russian nesting dolls named matryoshkas sold in one of the souvenir stores nearby, and you'd like to buy several of them. The store has $$$n$$$ different matryoshkas. Any matryoshka is a figure of volume $$$out_i$$$ with an empty space inside of volume $$$in_i$$$ (of course, $$$out_i > in_i$$$).You don't have much free space inside your bag, but, fortunately, you know that matryoshkas can be nested one inside another. Formally, let's call a set of matryoshkas nested if we can rearrange dolls in such a way, that the first doll can be nested inside the second one, the second doll — inside the third one and so on. Matryoshka $$$i$$$ can be nested inside matryoshka $$$j$$$ if $$$out_i \le in_j$$$. So only the last doll will take space inside your bag.Let's call extra space of a nested set of dolls as a total volume of empty space inside this structure. Obviously, it's equal to $$$in_{i_1} + (in_{i_2} - out_{i_1}) + (in_{i_3} - out_{i_2}) + \dots + (in_{i_k} - out_{i_{k-1}})$$$, where $$$i_1$$$, $$$i_2$$$, ..., $$$i_k$$$ are the indices of the chosen dolls in the order they are nested in each other.Finally, let's call a nested subset of the given sequence as big enough if there isn't any doll from the sequence that can be added to the nested subset without breaking its nested property.You want to buy many matryoshkas, so you should choose a big enough nested subset to buy it. But you will be disappointed if too much space in your bag will be wasted, so you want to choose a big enough subset so that its extra space is minimum possible among all big enough subsets. Now you wonder, how many different nested subsets meet these conditions (they are big enough, and there is no big enough subset such that its extra space is less than the extra space of the chosen subset). Two subsets are considered different if there exists at least one index $$$i$$$ such that one of the subsets contains the $$$i$$$-th doll, and another subset doesn't.Since the answer can be large, print it modulo $$$10^9 + 7$$$.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of matryoshkas. The next $$$n$$$ lines contain a description of each doll: two integers $$$out_i$$$ and $$$in_i$$$ ($$$1 \le in_i < out_i \le 10^9$$$) — the outer and inners volumes of the $$$i$$$-th matryoshka.

Print one integer — the number of big enough nested subsets such that extra space of each of these subsets is minimum possible. Since the answer can be large, print it modulo $$$10^9 + 7$$$.

NoteThere are $$$6$$$ big enough nested subsets with minimum possible extra space in the example:   $$$\{1, 5\}$$$: we can't add any other matryoshka and keep it nested; it's extra space is $$$1$$$;  $$$\{1, 6\}$$$;  $$$\{2, 4, 5\}$$$;  $$$\{2, 4, 6\}$$$;  $$$\{3, 4, 5\}$$$;  $$$\{3, 4, 6\}$$$. There are no more "good" subsets because, for example, subset $$$\{6, 7\}$$$ is not big enough (we can add the $$$4$$$-th matryoshka to it) or subset $$$\{4, 6, 7\}$$$ has extra space equal to $$$2$$$.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import Data.Char (ord)
import Data.List (sort)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  n <- fmap parseInt getLine
  a <- replicateM n (fmap parseInts getLine)
  let e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import qualified Data.ByteString.Char8 as BS
  ( dropWhile
  , foldl
  , getContents
  , getLine
  , lines
  , readInt
  , words
  )
import Data.Char (isSpace, ord)
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInts s = parse id s []
  where
    parse r s =
      case BS.readInt s of
        Nothing -> r
        Just (x, s') -> parse (r . (x :)) (BS.dropWhile isSpace s')

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  [n] <- fmap parseInts BS.getLine
  contents <- BS.getContents
  let a = fmap parseInts . BS.lines $ contents
      e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Applicative (liftA2)
import Control.Monad (join, replicateM)
import Control.Monad.State.Strict (State, execState, get, put)
import Data.Char (ord)
import Data.List (sort)
import Data.Monoid ((<>))
import Data.Ord (Down(Down))
import Data.Ratio (denominator, numerator)
import Data.Sequence (Seq, Seq(Empty), Seq((:<|)), Seq((:|>)), (!?), index)
import qualified Data.Sequence as S (replicate, update)
import GHC.TypeNats (type (+), type (^), KnownNat, Nat, natVal)
import Numeric.Natural (Natural)
import qualified Data.ByteString.Char8 as BS (getContents, lines, readInt, words, getLine, foldl)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField (10 ^ 9 + 7)

data Event =
  Event
    { getKey :: !Int
    , getMark :: !(Either Int Int)
    }
  deriving (Show, Eq)

instance Ord Event where
  compare (Event k m) (Event k' m') = compare (Down k) (Down k') <> compare m m'

type Env = (Bool, Ways, Seq Ways)

type Ways = (Int, MField)

update :: Ways -> Ways -> Ways
update (b, c) (b', c')
  | b < b' = (b, c)
  | b == b' = (b, c + c')
  | otherwise = (b', c')

solve :: Event -> State Env ()
solve (Event k m) = do
  (large, w@(best, count), mem) <- get
  case m of
    Left i -> do
      let (b, c) = index mem i
          b' = b + k
          w' = update w (b', c)
      put (False, w', mem)
    Right i -> do
      let mem' =
            if large
              then S.update i (update (best - k, count) (0, 1)) mem
              else S.update i (best - k, count) mem
      put (large, w, mem')

main = do
  n <- fmap parseInt getLine
  contents <- getContents
  let a = fmap parseInts . lines $ contents
      e =
        join
          [[Event l (Left i), Event r (Right i)] | (i, [r, l]) <- zip [0 ..] a]
      se = sort e
      mk = maximum . fmap head $ a
      initial = (True, (mk, 0), S.replicate n (0, 0))
      (_, (_, ret), _) = execState (mapM solve se) initial
  print ret


You have got a shelf and want to put some books on it.You are given $$$q$$$ queries of three types:  L $$$id$$$ — put a book having index $$$id$$$ on the shelf to the left from the leftmost existing book;  R $$$id$$$ — put a book having index $$$id$$$ on the shelf to the right from the rightmost existing book;  ? $$$id$$$ — calculate the minimum number of books you need to pop from the left or from the right in such a way that the book with index $$$id$$$ will be leftmost or rightmost. You can assume that the first book you will put can have any position (it does not matter) and queries of type $$$3$$$ are always valid (it is guaranteed that the book in each such query is already placed). You can also assume that you don't put the same book on the shelf twice, so $$$id$$$s don't repeat in queries of first two types.Your problem is to answer all the queries of type $$$3$$$ in order they appear in the input.Note that after answering the query of type $$$3$$$ all the books remain on the shelf and the relative order of books does not change.If you are Python programmer, consider using PyPy instead of Python when you submit your code.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 2 \cdot 10^5$$$) — the number of queries. Then $$$q$$$ lines follow. The $$$i$$$-th line contains the $$$i$$$-th query in format as in the problem statement. It is guaranteed that queries are always valid (for query type $$$3$$$, it is guaranteed that the book in each such query is already placed, and for other types, it is guaranteed that the book was not placed before). It is guaranteed that there is at least one query of type $$$3$$$ in the input. In each query the constraint $$$1 \le id \le 2 \cdot 10^5$$$ is met.

Print answers to queries of the type $$$3$$$ in order they appear in the input.

NoteLet's take a look at the first example and let's consider queries:   The shelf will look like $$$[1]$$$;  The shelf will look like $$$[1, 2]$$$;  The shelf will look like $$$[1, 2, 3]$$$;  The shelf looks like $$$[1, \textbf{2}, 3]$$$ so the answer is $$$1$$$;  The shelf will look like $$$[4, 1, 2, 3]$$$;  The shelf looks like $$$[4, \textbf{1}, 2, 3]$$$ so the answer is $$$1$$$;  The shelf will look like $$$[5, 4, 1, 2, 3]$$$;  The shelf looks like $$$[5, 4, \textbf{1}, 2, 3]$$$ so the answer is $$$2$$$. Let's take a look at the second example and let's consider queries:   The shelf will look like $$$[100]$$$;  The shelf will look like $$$[100, 100000]$$$;  The shelf will look like $$$[100, 100000, 123]$$$;  The shelf will look like $$$[101, 100, 100000, 123]$$$;  The shelf looks like $$$[101, 100, 100000, \textbf{123}]$$$ so the answer is $$$0$$$;  The shelf will look like $$$[10, 101, 100, 100000, 123]$$$;  The shelf will look like $$$[10, 101, 100, 100000, 123, 115]$$$;  The shelf looks like $$$[10, 101, \textbf{100}, 100000, 123, 115]$$$ so the answer is $$$2$$$;  The shelf will look like $$$[10, 101, 100, 100000, 123, 115, 110]$$$;  The shelf looks like $$$[10, 101, 100, 100000, 123, \textbf{115}, 110]$$$ so the answer is $$$1$$$.

-- Codeforces 1066C

import qualified Data.Map as Map
import Data.Maybe
import Data.List
import Data.Functor
import Control.Applicative

type Position = Char
type BookShelf = (Int, Int, Map.Map Int Int)

addBook :: BookShelf -> Position -> Int -> BookShelf
addBook (left, right, map) ch val
    | ch == 'L' = (left - 1, right, Map.insert val left map)
    | ch == 'R' = (left, right + 1, Map.insert val right map)

queryBook :: BookShelf -> Int -> Int
queryBook (left, right, map) val = min distl distr
    where pos = fromJust $ Map.lookup val map
          distl = pos - left - 1
          distr = right - pos - 1

process :: String -> BookShelf -> IO BookShelf
process str shelf
    | ch == 'L' || ch == 'R' = pure $ addBook shelf ch val
    | otherwise = do
                        (putStrLn $ show $ queryBook shelf val) >> return shelf
    where ch = head $ head $ words str :: Char
          val = read $ last $ words str :: Int

processList :: [String] -> IO BookShelf
processList list = foldl' fun (pure (0, 1, Map.empty)) list
    where fun = (\ioshelf str -> ioshelf >>= (process str))

main :: IO ()
main = do
    n <- read <$> getLine :: IO Int
    shelf <- getContents >>= (processList.(take n).lines)
    return ()


You have an undirected graph consisting of $$$n$$$ vertices with weighted edges.A simple cycle is a cycle of the graph without repeated vertices. Let the weight of the cycle be the XOR of weights of edges it consists of.Let's say the graph is good if all its simple cycles have weight $$$1$$$. A graph is bad if it's not good.Initially, the graph is empty. Then $$$q$$$ queries follow. Each query has the next type:   $$$u$$$ $$$v$$$ $$$x$$$ — add edge between vertices $$$u$$$ and $$$v$$$ of weight $$$x$$$ if it doesn't make the graph bad. For each query print, was the edge added or not.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$3 \le n \le 3 \cdot 10^5$$$; $$$1 \le q \le 5 \cdot 10^5$$$) — the number of vertices and queries. Next $$$q$$$ lines contain queries — one per line. Each query contains three integers $$$u$$$, $$$v$$$ and $$$x$$$ ($$$1 \le u, v \le n$$$; $$$u \neq v$$$; $$$0 \le x \le 1$$$) — the vertices of the edge and its weight. It's guaranteed that there are no multiple edges in the input.

For each query, print YES if the edge was added to the graph, or NO otherwise (both case-insensitive).

YES
YES
YES
YES
YES
NO
YES
YES
NO
YES
YES
NO

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.State
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Foldable
import Data.Functor
import Data.Graph
import Data.Monoid
import qualified Data.IntSet as IS
import qualified Data.ByteString.Char8 as C

data WEdge = WEdge !Int !Int !Int

solve :: IO ()
solve = do
    [n, q] <- readInts
    e <- replicateM q $ (\[u, v, w] -> WEdge u v w) <$> readInts
    let ea = listArray (1, q) e :: Array Int WEdge
        (tes, rs) = runST $ do
            d <- newD (1, n)
            let f (WEdge u v _) = unionD u v d
            tes <- map fst <$> filterM (f . snd) (assocs ea)
            rs <- rootsD d
            return (IS.fromList tes, rs)

        maybeGood = is where
            wg = accumArray (flip (:)) [] (1, n) eds :: Array Int [(Int, Int)] where
                eds = concat [[(u, (v, w)), (v, (u, w))] | WEdge u v w <- map (ea!) $ IS.elems tes]
            da = array (1, n) $ foldr (\u ds -> go u u 0 ds) [] rs :: UArray Int Int where
                go p u d ds = (u, d) : foldr f ds (filter ((/=p) . fst) $ wg!u) where
                    f (v, w) = go u v (d `xor` w)
            is = [i | (i, WEdge u v w) <- assocs ea, i `IS.notMember` tes, da!u `xor` da!v `xor` w /= 0]

        tree = Node 0 ts where
            treeDFS :: Graph -> Int -> Tree Vertex
            treeDFS g u = go u u where
                go p u = Node u [go u v | v <- g!u, v /= p]
            ts = map (treeDFS g) rs
            g = buildG (1, n) $ concat [[(u, v), (v, u)] | WEdge u v _ <- map (ea!) $ IS.elems tes]
        lca = buildLCA (0, n) tree
        toRoot = array (0, n) $ go [] tree [] :: Array Int [Int] where
            go path (Node u ts) acc = (u, path') : foldr (go path') acc ts where path' = u:path
        time = array (0, n) $ zip (toList tree) [0..] :: UArray Int Int
        sz = array (0, n) $ fst $ go tree [] :: UArray Int Int where
            go (Node u ts) acc = ((u, s):acc', s) where
                (acc', s) = foldl' f (acc, 1) ts
                f (acc, s) node = s'' `seq` (acc', s'') where
                    (acc', s') = go node acc
                    s'' = s + s'

        good = IS.fromList $ evalState (filterM f maybeGood) $ buildF (0, n) where
            f i = do
                let WEdge u v _ = ea!i
                    l = queryLCA u v lca
                    qf = queryF . (time!)
                    upd u = mapM_ f $ takeWhile (/= l) $ toRoot!u where
                        f :: Vertex -> State (FTree (Sum Int)) ()
                        f u = do
                            modify' $ updateF (time!u) $ Sum 1
                            modify' $ updateF (time!u + sz!u) $ Sum (-1)
                c <- gets $ \ft -> qf u ft + qf v ft - 2 * qf l ft
                if c > 0
                    then return False
                    else upd u >> upd v $> True

        ok i = i `IS.member` tes || i `IS.member` good

    putStr $ unlines $ [if ok i then "YES" else "NO" | i <- [1..q]]

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

type DSU s = STUArray s Int Int

newD :: (Int, Int) -> ST s (DSU s)
newD bnds = newArray bnds (-1)

findD :: Int -> DSU s -> ST s Int
findD i d = do
    pi <- readArray d i
    if pi < 0
        then return i
        else findD pi d >>= \ri -> writeArray d i ri $> ri

unionD :: forall s. Int -> Int -> DSU s -> ST s Bool
unionD i j d = join $ go <$> findD i d <*> findD j d where
    upd i j si sj = if si > sj then upd j i sj si else writeArray d i (si + sj) >> writeArray d j i :: ST s ()
    go i j = if i == j then return False else join (upd i j <$> readArray d i <*> readArray d j) $> True

rootsD :: DSU s -> ST s [Int]
rootsD d = getAssocs d <&> \as -> [i | (i, pi) <- as, pi < 0]

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

type SparseTable = Array Int (UArray Int Int)

fromArraySP :: UArray Int Int -> SparseTable
fromArraySP a = if l > h then error "invalid range" else t where
    (l, h) = bounds a
    n = h - l + 1
    k = finiteBitSize n - countLeadingZeros n - 1
    t = fArray (0, k) f
    f j | j == 0    = a
        | otherwise = fUArray (l, h - 2 * hf + 1) g
        where hf = 1 `shiftL` (j - 1)
              p = t!(j - 1)
              g i = (p!i) `min` (p!(i + hf))

querySP :: Int -> Int -> SparseTable -> Int
querySP l r _ | l > r = error "invalid range"
querySP l r t = (t!k!l) `min` (t!k!l') where
    n = r - l + 1
    k = finiteBitSize n - countLeadingZeros n - 1
    l' = r + 1 - 1 `shiftL` k

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

data LCA = LCA !SparseTable !(UArray Int Int) !(UArray Int Int)

buildLCA :: Bounds -> Tree Vertex -> LCA
buildLCA (l, r) _ | l > r = error "empty range"
buildLCA (l, r) rt = LCA sp time itime where
    n = r - l + 1
    itime = listArray (1, n) $ toList rt
    time = array (l, r) $ zip (toList rt) [1..]
    euler = go rt [] where
        go (Node u ts) acc = foldr (((time!u :) .) . go) acc ts
    sp = fromArraySP $ listArray (1, n - 1) euler

queryLCA :: Vertex -> Vertex -> LCA -> Vertex
queryLCA u v (LCA sp time itime) = l where
    (fu, fv) = (time!u, time!v)
    (fu', fv') = (min fu fv, max fu fv - 1)
    l = if u == v then u else itime ! querySP fu' fv' sp

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

data FTree a = FTree !(Int, Int, Int) !(FNode a)
data FNode a = FTip | FBin !a !(FNode a) !(FNode a)

buildF :: Monoid a => (Int, Int) -> FTree a
buildF (l, r) | l > r = error "empty range"
buildF (l, r) = FTree (l, r, bit ht) (go ht) where
    n = r - l + 1
    ht = finiteBitSize n - countLeadingZeros n - 1
    go j | j < 0     = FTip
         | otherwise = FBin mempty (go $ j - 1) (go $ j - 1)

updateF :: Monoid a => Int -> a -> FTree a -> FTree a
updateF i y f@(FTree lrp@(l, r, p) rt) = if i > r then f else FTree lrp (go rt p) where
    i' = i - l + 1
    q = bit $ countTrailingZeros i'
    go ~(FBin x l r) p
        | i' .&. p == 0 = FBin (x <> y) (go l p') r
        | p == q        = FBin (x <> y) l r
        | otherwise     = FBin x l (go r p')
        where p' = p `shiftR` 1

queryF :: Monoid a => Int -> FTree a -> a
queryF i (FTree (l, r, p) rt) = go rt p mempty where
    i' = i - l + 1
    q = bit $ countTrailingZeros i'
    go ~(FBin x l r) p acc
        | i' .&. p == 0 = go l p' acc
        | p == q        = acc <> x
        | otherwise     = go r p' $! acc <> x
        where p' = p `shiftR` 1

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

fArray :: (Ix i) => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

fUArray :: (Int, Int) -> (Int -> Int) -> UArray Int Int
fUArray b f = array b [(i, f i) | i <- range b]

parseInt = f . C.readInt where f (Just (i, _)) = i
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve


You are given a permutation $$$p_1, p_2, \ldots, p_n$$$ of length $$$n$$$. You have to choose two integers $$$l,r$$$ ($$$1 \le l \le r \le n$$$) and reverse the subsegment $$$[l,r]$$$ of the permutation. The permutation will become $$$p_1,p_2, \dots, p_{l-1},p_r,p_{r-1}, \dots, p_l,p_{r+1},p_{r+2}, \dots ,p_n$$$.Find the lexicographically smallest permutation that can be obtained by performing exactly one reverse operation on the initial permutation.Note that for two distinct permutations of equal length $$$a$$$ and $$$b$$$, $$$a$$$ is lexicographically smaller than $$$b$$$ if at the first position they differ, $$$a$$$ has the smaller element.A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 500$$$) — the length of the permutation. The second line of each test case contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$) — the elements of the permutation.

For each test case print the lexicographically smallest permutation you can obtain.

NoteIn the first test case, the permutation has length $$$1$$$, so the only possible segment is $$$[1,1]$$$. The resulting permutation is $$$[1]$$$.In the second test case, we can obtain the identity permutation by reversing the segment $$$[1,2]$$$. The resulting permutation is $$$[1,2,3]$$$.In the third test case, the best possible segment is $$$[2,3]$$$. The resulting permutation is $$$[1,2,4,3]$$$.In the fourth test case, there is no lexicographically smaller permutation, so we can leave it unchanged by choosing the segment $$$[1,1]$$$. The resulting permutation is $$$[1,2,3,4,5]$$$.

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

solve :: [Int] -> [Int]
solve arr =
    map snd as ++ rbs ++ reverse rcs
  where
    (as, as') = span (uncurry (==)) $ zip [1 ..] arr
    (rcs, rbs) = span (/= length as + 1) $ map snd $ reverse as'

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

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

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

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

str = string7

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

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

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

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

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

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

enumerate = zip [0..]

argmin :: [Int] -> Int
argmin a = let t = enumerate a in
  fst $ foldl (\(mni, mn) (i, x) -> if x < mn then (i, x) else (mni, mn)) (0, 999999999) t

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let pref = (+) (-1) $ maximum $ scanl (\l x -> if l == x then (l+1) else 0) 1 a
  let first = take pref a
  let rest = drop pref a
  let min_index = argmin rest
  let rest_pre = take (1+min_index) rest
  let rest_suf = drop (1+min_index) rest
  let res = first ++ reverse rest_pre ++ rest_suf
  pure $ putInts res

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    ps <- readInts
    let (as, as') = span (uncurry (==)) $ zip [1..] ps
        an = length as
        (rcs, rbs) = span (/= an + 1) $ map snd $ reverse as'
    putStrLn $ unwords $ map show $ map snd as ++ rbs ++ reverse rcs

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    p <- replicateM n getInt
    let
      (q1, q2) = span (uncurry (==)) $ zip [1..] p
      [r1, r2] = map (map snd) [q1, q2]
      x = minimum r2
      (s2, s3) = span (> x) r2
    pure $ putInts $ r1 ++ take 1 s3 ++ reverse s2 ++ drop 1 s3

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

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

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

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

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

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

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

solve :: [Int] -> [Int]
solve arr =
    map snd as ++ ras ++ reverse rbs
  where
    (as, as') = span (uncurry (==)) $ zip [1 ..] arr
    (ras, rbs) = span (/= length as + 1) $ map snd $ reverse as'

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

import Control.Monad (forM_)

solve str =
    let len = length str
     in if even len && (take (len `div` 2) str == drop (len `div` 2) str) then "YES" else "NO"

main :: IO ()
main = do
    n <- readLn :: IO Int
    forM_ [1 .. n] $ \i -> do
        x <- getLine
        putStrLn $ solve x

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

revv :: [a] -> Int -> Int -> [a]
revv arr i j = revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

index :: Eq t => [t] -> t -> Int -> Int -> Int
index arr n i l
    | i < l =
        if arr !! i /= n
            then index arr n (i + 1) l
            else i
    | otherwise = i - 1

solve :: [Int] -> Int -> Int -> [Int]
solve arr i l
    | i < l =
        if arr !! i == (i + 1)
            then arr !! i : solve arr (i + 1) l
            else revv arr i (index arr (i + 1) (i + 1) l)
    | otherwise = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

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

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> Int -> Int -> [a]
revv arr i j = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solve :: Ord a => [a] -> Int -> Int -> [a]
solve arr i l
    | i < l - 1 =
        if arr !! i > arr !! (i + 1)
            then solveh arr i l
            else solve arr (i + 1) l
    | otherwise = arr

solveh :: Ord a => [a] -> Int -> Int -> [a]
solveh arr i l =
    if l == 1
        then arr
        else minimum $ map (revv arr i) [i + 1 .. l - 1]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

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

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> (Int, Int) -> [a]
revv arr (i, j) = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solvee arr l i =
    if l == 1
        then arr
        else minimum $ map (revv arr) (flat [[(x, y) | y <- [x + 1 .. l - 1]] | x <- [i .. l - 1]])

solve arr i l
    | i < l - 1 = if arr !! i >  arr !! (i + 1) then solvee arr l i else solve arr (i+1) l
    | otherwise = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc -> x ++ " " ++ acc) $ map show $ solve arr 0 n

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

flat :: [[a]] -> [a]
flat [] = []
flat [a1] = a1
flat (a1 : a2) = a1 ++ flat a2

revv :: [a] -> (Int, Int) -> [a]
revv arr (i, j) = take i arr ++ revvh arr i j ++ drop (j + 1) arr

revvh :: [a] -> Int -> Int -> [a]
revvh arr i j
    | i <= j = revvh arr (i + 1) j ++ [arr !! i]
    | otherwise = []

solve arr =
    if l == 1
        then arr
        else minimum (map (revv arr) $ flat [[(x, y) | y <- [x + 1 .. l - 1]] | x <- [0 .. l - 1]])
  where
    l = length arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ foldl1 (\x acc-> x ++ " " ++ acc) $ map show $ solve arr

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

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

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

str = string7

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

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

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

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

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

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

enumerate = zip [0..]

argmin :: [Int] -> Int
argmin a = let t = enumerate a in
  snd $ foldl (\(mni, mn) (i, x) -> if x < mn then (i, x) else (mn, mni)) (999999999, 0) t

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let pref = (+) (-1) $ maximum $ scanl (\l x -> if l == x then (l+1) else 0) 1 a
  if pref == n-1 then pure $ str "hello" else pure $ str "bye"
  let first = take pref a
  let rest = drop pref a
  let min_index = argmin rest
  let rest_pre = take (1+min_index) rest
  let rest_suf = drop (1+min_index) rest
  let res = first ++ reverse rest_pre ++ rest_suf
  pure $ putInts res


One foggy Stockholm morning, Karlsson decided to snack on some jam in his friend Lillebror Svantenson's house. Fortunately for Karlsson, there wasn't anybody in his friend's house. Karlsson was not going to be hungry any longer, so he decided to get some food in the house.Karlsson's gaze immediately fell on n wooden cupboards, standing in the kitchen. He immediately realized that these cupboards have hidden jam stocks. Karlsson began to fly greedily around the kitchen, opening and closing the cupboards' doors, grab and empty all the jars of jam that he could find.And now all jars of jam are empty, Karlsson has had enough and does not want to leave traces of his stay, so as not to let down his friend. Each of the cupboards has two doors: the left one and the right one. Karlsson remembers that when he rushed to the kitchen, all the cupboards' left doors were in the same position (open or closed), similarly, all the cupboards' right doors were in the same position (open or closed). Karlsson wants the doors to meet this condition as well by the time the family returns. Karlsson does not remember the position of all the left doors, also, he cannot remember the position of all the right doors. Therefore, it does not matter to him in what position will be all left or right doors. It is important to leave all the left doors in the same position, and all the right doors in the same position. For example, all the left doors may be closed, and all the right ones may be open.Karlsson needs one second to open or close a door of a cupboard. He understands that he has very little time before the family returns, so he wants to know the minimum number of seconds t, in which he is able to bring all the cupboard doors in the required position.Your task is to write a program that will determine the required number of seconds t.

The first input line contains a single integer n — the number of cupboards in the kitchen (2 ≤ n ≤ 104). Then follow n lines, each containing two integers li and ri (0 ≤ li, ri ≤ 1). Number li equals one, if the left door of the i-th cupboard is opened, otherwise number li equals zero. Similarly, number ri equals one, if the right door of the i-th cupboard is opened, otherwise number ri equals zero. The numbers in the lines are separated by single spaces.

In the only output line print a single integer t — the minimum number of seconds Karlsson needs to change the doors of all cupboards to the position he needs.

-- references
-- http://en.wikibooks.org/wiki/Haskell/Simple_input_and_output
-- http://www.haskell.org/haskellwiki/Haskell_Tutorial_for_C_Programmers
-- http://en.wikibooks.org/wiki/Haskell/Next_steps
-- http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Parsing
-- http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#parse
-- http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#decimal
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- enots CF solution 2C

ans :: Int -> [(Int, Int)] -> Int
ans a b = minimum ((sum (fst (unzip b)) : [(a - (sum (fst (unzip b))))]))
	+ minimum ((sum (snd (unzip b)) : [(a - (sum (snd (unzip b))))]))

process :: [String] -> [(Int, Int)]
process [] 	  = []
process (a : (b : c)) = (read a, read b) : (process c)
process _         = []

main :: IO()
main = do
	str <- getContents
	putStrLn (show (ans (read ((words str) !! 0)) (process (tail (words str)))))

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
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.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 System.IO
-- import Debug.Trace

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

main = do
  n <- readLn
  ps <- replicateM n getInts

  let
    s1 = sum $ map (!!0) ps
    s2 = sum $ map (!!1) ps

  print $ min s1 (n-s1) + min s2 (n-s2)

import Data.List
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> map words |> map (map read) :: [[Int]]
  sz = ls |> head |> head
  doors = ls |> tail
  in solve doors sz |> show

solve doors sz = let
  left = doors |> map head
  right = doors |> map last
  leftOpen = left |> filter (== 1) |> length
  leftClosed = sz - leftOpen
  rightOpen = right |> filter (== 1) |> length
  rightClosed = sz - rightOpen
  in min leftOpen leftClosed + min rightOpen rightClosed

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

f a b c d [] = (a,b,c,d)
f a b c d ([0,1]:es) = f (a+1) b c (d+1) es
f a b c d ([0,0]:es) = f (a+1) b (c+1) d es
f a b c d ([1,0]:es) = f a (b+1) (c+1) d es
f a b c d ([1,1]:es) = f a (b+1) c (d+1) es

main = do
    n <- readLn :: IO Int
    ns <- replicateM n ((map (fst . fromJust . C.readInt ) . C.words ) <$> C.getLine )
    let (a,b,c,d) = f 0 0 0 0 ns
    print $ (min a b)  + (min c d)

import Control.Monad (liftM)

solve :: Int -> [(Int, Int)] -> Int
solve n as  =  min a (n - a) + min b (n - b)
  where
    a  =  length $ filter (\(a, b) -> a == 0) as
    b  =  length $ filter (\(a, b) -> b == 0) as

parsePair :: String -> (Int, Int)
parsePair line  =  case map read (words line) of
    [a, b]  ->  (a, b)

main :: IO ()
main  =  do
    n   <-  readLn
    as  <-  mapM (const $ liftM parsePair getLine) [1..n]
    print $ solve n as

import Control.Monad
main = do
    n <- getLine
    doors <- forM [1..read n] (\_ -> do
        s <- getLine
        let [l, r] = map read $ words s
        return (l, r))
    print $ solve doors
solve doors = count left + count right
    where left = map fst doors
          right = map snd doors
count parts = min (length parts - sum parts) (sum parts)

import qualified Data.ByteString.Char8 as B
import Control.Applicative

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

main = do
  n <- readLn
  xs <- map readInt.B.words<$>B.getContents
  let f x y (l:r:rest) = f (x+l) (y+r) rest
      f x y [] = min x (n-x) + min y (n-y)
  print $ f 0 0 xs

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

main = do
	a<-read <$> getLine :: IO Int
	[c,d]<-transpose <$> map(map read) <$> map words <$> replicateM a getLine :: IO [[Int]]
	let c1 = length $ filter (==1) c
	let d1 = length $ filter (==1) d
	print $ (min c1 (a-c1)) + (min d1 (a-d1))

import qualified Data.ByteString.Char8 as B
import Control.Applicative
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
        n <- readLn
        xs <- map readInt . B.words <$> B.getContents
        let f x y (l:r:rest) = f (x+l) (y+r) rest
            f x y [] = min x (n-x) + min y (n-y)
        print $ f 0 0 xs

import Data.List
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> map words |> map (map read) :: [[Int]]
  sz = ls |> head |> head
  doors = ls |> tail
  in solve doors sz |> show

solve doors sz = let
  left = doors |> map head
  right = doors |> map last
  leftOpen = left |> filter (== 1) |> length
  leftClosed = sz - leftOpen
  rightOpen = right |> filter (== 1) |> length
  rightClosed = sz - rightOpen
  x = leftClosed + rightOpen
  y = leftOpen + rightClosed
  in min x y


IT City administration has no rest because of the fame of the Pyramids in Egypt. There is a project of construction of pyramid complex near the city in the place called Emerald Walley. The distinction of the complex is that its pyramids will be not only quadrangular as in Egypt but also triangular and pentagonal. Of course the amount of the city budget funds for the construction depends on the pyramids' volume. Your task is to calculate the volume of the pilot project consisting of three pyramids — one triangular, one quadrangular and one pentagonal.The first pyramid has equilateral triangle as its base, and all 6 edges of the pyramid have equal length. The second pyramid has a square as its base and all 8 edges of the pyramid have equal length. The third pyramid has a regular pentagon as its base and all 10 edges of the pyramid have equal length.

The only line of the input contains three integers l3, l4, l5 (1 ≤ l3, l4, l5 ≤ 1000) — the edge lengths of triangular, quadrangular and pentagonal pyramids correspondingly.

Output one number — the total volume of the pyramids. Absolute or relative error should not be greater than 10 - 9.

import Control.Monad
main = do
    [a,b,c] <- liftM (map read . words) (getLine) :: IO [Double]
    putStrLn $ show $ (a*a*a/(6*sqrt(2))) + (b*b*(sqrt(0.5))*b/3) + s5 c

s5 c = (1/4)*sqrt(5*(5+2*(sqrt 5))) * c*c * (1/3) * sqrt(c^2 - r^2)
    where r = (1/2)*c*1.7013016167

import Control.Monad (liftM)

solve :: Double -> Double -> Double
solve n l =
    let a = pi / n in
    let l' = l / 2 / sin a in
    let h = sqrt (l ** 2 - l' ** 2) in
    l' * l' * sin (2 * a) / 2 * h / 3 * n

main :: IO ()
main = do
    [l_3, l_4, l_5] <- (map read . words) `liftM` getContents :: IO [Double]
    print $ solve 3 l_3 + solve 4 l_4 + solve 5 l_5