The Alice's computer is broken, so she can't play her favorite card game now. To help Alice, Bob wants to answer $$$n$$$ her questions. Initially, Bob holds one card with number $$$0$$$ in the left hand and one in the right hand. In the $$$i$$$-th question, Alice asks Bob to replace a card in the left or right hand with a card with number $$$k_i$$$ (Bob chooses which of two cards he changes, Bob must replace exactly one card).After this action, Alice wants the numbers on the left and right cards to belong to given segments (segments for left and right cards can be different). Formally, let the number on the left card be $$$x$$$, and on the right card be $$$y$$$. Then after the $$$i$$$-th swap the following conditions must be satisfied: $$$a_{l, i} \le x \le b_{l, i}$$$, and $$$a_{r, i} \le y \le b_{r,i}$$$.Please determine if Bob can answer all requests. If it is possible, find a way to do it.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 100\,000$$$, $$$2 \le m \le 10^9$$$) — the number of questions and the maximum possible value on the card. Then $$$n$$$ queries are described. Every description contains 3 lines. The first line of the description of the $$$i$$$-th query contains a single integer $$$k_i$$$ ($$$0 \le k_i \le m$$$) — the number on a new card. The second line of the description of the $$$i$$$-th query contains two integers $$$a_{l, i}$$$ and $$$b_{l, i}$$$ ($$$0 \le a_{l, i} \le b_{l, i} \le m$$$) — the minimum and maximum values of the card at the left hand after the replacement. The third line of the description of the $$$i$$$-th query contains two integers $$$a_{r, i}$$$ and $$$b_{r,i}$$$ ($$$0 \le a_{r, i} \le b_{r,i} \le m$$$) — the minimum and maximum values of the card at the right hand after the replacement.

At the first line, print "Yes", if Bob can answer all queries, and "No" otherwise. If Bob can answer all $$$n$$$ queries, then at the second line print $$$n$$$ numbers: a way to satisfy all requirements. If in $$$i$$$-th query Bob needs to replace the card in the left hand, print $$$0$$$, otherwise print $$$1$$$. If there are multiple answers, print any.

import Control.Monad
import Data.List
import System.IO
import Text.Printf
import Data.Maybe

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

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

main = do
    [n,m] <- getInts
    triples <- sequence $ take n $ repeat getItem
    let revTs = reverse triples
    let lastRS = foldl' combine (XYUnion UnrestI UnrestI [] []) revTs
    printSolution lastRS

getItem :: IO (Int,Interval,Interval)
getItem = do
    k <- head <$> getInts
    [a,b] <- getInts
    [c,d] <- getInts
    return (k, Interval a b, Interval c d)

produceSolution :: Int -> IO ()
produceSolution t = do
    putStrLn $ printf "Case #%d: %d" t

printSolution :: RegionState -> IO()
printSolution EmptyR = do putStrLn "No"
printSolution (XRest itrvl bl) = if inInt itrvl 0
                                    then putStrLn $ unlines ["Yes", toAnsString bl]
                                 else putStrLn "No"
printSolution (YRest itrvl bl) = if inInt itrvl 0
                                    then putStrLn $ unlines ["Yes", toAnsString bl]
                                 else putStrLn "No"
printSolution (XYUnion itrvlx itrvly blx bly) = if inInt itrvlx 0
                                                    then putStrLn $ unlines ["Yes", toAnsString blx]
                                                 else if inInt itrvly 0
                                                    then putStrLn $ unlines ["Yes", toAnsString bly]
                                                 else putStrLn "No"

toAnsString :: [Bool] -> String
toAnsString = (intercalate " ") . (map (show.fromEnum))

data Interval = EmptyI
               | Interval Int Int
               | UnrestI
               deriving (Show)

inInt :: Interval -> Int -> Bool
inInt EmptyI _ = False
inInt (Interval a b) x = a<=x && x<=b
inInt UnrestI _ = True

iintersect :: Interval -> Interval -> Interval
iintersect EmptyI _ = EmptyI
iintersect _ EmptyI = EmptyI
iintersect UnrestI a = a
iintersect a UnrestI = a
iintersect (Interval a b) (Interval c d) =
    if x <= y
        then Interval x y
    else EmptyI
    where
        x = max a c
        y = min b d

data RegionState = EmptyR
                  | XRest Interval [Bool]
                  | YRest Interval [Bool]
                  | XYUnion Interval Interval [Bool] [Bool]
                  deriving (Show)

reduce :: RegionState -> RegionState
reduce EmptyR = EmptyR
reduce (XRest EmptyI _) = EmptyR
reduce (YRest EmptyI _) = EmptyR
reduce (XYUnion EmptyI EmptyI _ _) = EmptyR
reduce (XYUnion EmptyI itrvly _ bl) = YRest itrvly bl
reduce (XYUnion itrvlx EmptyI bl _) = XRest itrvlx bl
reduce rs = rs

invX :: RegionState -> Int -> Interval
invX EmptyR _ = EmptyI
invX (XRest itrvl _) x = if inInt itrvl x
                            then UnrestI
                         else EmptyI
invX (YRest itrvl _) x = itrvl
invX (XYUnion itrvlx itrvly _ _) x = if inInt itrvlx x
                                        then UnrestI
                                     else itrvly

invY :: RegionState -> Int -> Interval
invY EmptyR _ = EmptyI
invY (XRest itrvl _) y = itrvl
invY (YRest itrvl _) y = if inInt itrvl y
                            then UnrestI
                         else EmptyI
invY (XYUnion itrvlx itrvly _ _) y = if inInt itrvly y
                                        then UnrestI
                                     else itrvlx

-- if there exists a y such that (x,y) is in the region,
-- we give Just a sequence that works for any such (x,y).
--
-- otherwise we give Nothing
getSeqX :: RegionState -> Int -> Maybe [Bool]
getSeqX EmptyR _ = Nothing
getSeqX (XRest itrvl bl) x = if inInt itrvl x
                                then Just bl
                             else Nothing
getSeqX (YRest itrvl bl) x = Just bl
getSeqX (XYUnion itrvlx itrvly blx bly) x = if inInt itrvlx x
                                               then Just blx
                                            else Just bly

getSeqY :: RegionState -> Int -> Maybe [Bool]
getSeqY EmptyR _ = Nothing
getSeqY (XRest itrvl bl) y = Just bl
getSeqY (YRest itrvl bl) y = if inInt itrvl y
                                then Just bl
                             else Nothing
getSeqY (XYUnion itrvlx itrvly blx bly) y = if inInt itrvly y
                                               then Just bly
                                            else Just blx

combine :: RegionState -> (Int, Interval, Interval) -> RegionState
combine EmptyR _ = EmptyR
combine rs (k,itrvlx, itrvly) =
    case (inInt itrvlx k, inInt itrvly k) of
         (False, False) -> EmptyR
         (True, False) -> reduce $ YRest yint seqx
         (False, True) -> reduce $ XRest xint seqy
         (True, True) -> reduce $ XYUnion xint yint seqy seqx
    where
        xinv = invX rs k -- in interval of ys
        yinv = invY rs k
        xint = yinv `iintersect` itrvlx
        yint = xinv `iintersect` itrvly
        seqx = False:(fromJust $ getSeqX rs k) --fromJust should only get evaluated if nothing
        seqy = True:(fromJust $ getSeqY rs k)

import Control.Monad
import Data.List
import System.IO
import Text.Printf
import Data.Maybe

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

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

main = do
    [n,m] <- getInts
    triples <- sequence $ take n $ repeat getItem
    let revTs = reverse triples
    let lastRS = foldl' combine (XYUnion UnrestI UnrestI [] []) revTs
    printSolution lastRS

getItem :: IO (Int,Interval,Interval)
getItem = do
    k <- head <$> getInts
    [a,b] <- getInts
    [c,d] <- getInts
    return (k, Interval a b, Interval c d)

produceSolution :: Int -> IO ()
produceSolution t = do
    putStrLn $ printf "Case #%d: %d" t

printSolution :: RegionState -> IO()
printSolution EmptyR = do putStrLn "No"
printSolution (XRest itrvl bl) = if inInt itrvl 0
                                    then putStrLn $ unlines ["Yes", toAnsString bl]
                                 else putStrLn "No"
printSolution (YRest itrvl bl) = if inInt itrvl 1
                                    then putStrLn $ unlines ["Yes", toAnsString bl]
                                 else putStrLn "No"
printSolution (XYUnion itrvlx itrvly blx bly) = if inInt itrvlx 0
                                                    then putStrLn $ unlines ["Yes", toAnsString blx]
                                                 else if inInt itrvly 1
                                                    then putStrLn $ unlines ["Yes", toAnsString bly]
                                                 else putStrLn "No"

toAnsString :: [Bool] -> String
toAnsString = (intercalate " ") . (map (show.fromEnum))

data Interval = EmptyI
               | Interval Int Int
               | UnrestI
               deriving (Show)

inInt :: Interval -> Int -> Bool
inInt EmptyI _ = False
inInt (Interval a b) x = a<=x && x<=b
inInt UnrestI _ = True

iintersect :: Interval -> Interval -> Interval
iintersect EmptyI _ = EmptyI
iintersect _ EmptyI = EmptyI
iintersect UnrestI a = a
iintersect a UnrestI = a
iintersect (Interval a b) (Interval c d) =
    if x <= y
        then Interval x y
    else EmptyI
    where
        x = max a c
        y = min b d

data RegionState = EmptyR
                  | XRest Interval [Bool]
                  | YRest Interval [Bool]
                  | XYUnion Interval Interval [Bool] [Bool]
                  deriving (Show)

reduce :: RegionState -> RegionState
reduce EmptyR = EmptyR
reduce (XRest EmptyI _) = EmptyR
reduce (YRest EmptyI _) = EmptyR
reduce (XYUnion EmptyI EmptyI _ _) = EmptyR
reduce (XYUnion EmptyI itrvly _ bl) = YRest itrvly bl
reduce (XYUnion itrvlx EmptyI bl _) = XRest itrvlx bl
reduce rs = rs

invX :: RegionState -> Int -> Interval
invX EmptyR _ = EmptyI
invX (XRest itrvl _) x = if inInt itrvl x
                            then UnrestI
                         else EmptyI
invX (YRest itrvl _) x = itrvl
invX (XYUnion itrvlx itrvly _ _) x = if inInt itrvlx x
                                        then UnrestI
                                     else itrvly

invY :: RegionState -> Int -> Interval
invY EmptyR _ = EmptyI
invY (XRest itrvl _) y = itrvl
invY (YRest itrvl _) y = if inInt itrvl y
                            then UnrestI
                         else EmptyI
invY (XYUnion itrvlx itrvly _ _) y = if inInt itrvly y
                                        then UnrestI
                                     else itrvlx

-- if there exists a y such that (x,y) is in the region,
-- we give Just a sequence that works for any such (x,y).
--
-- otherwise we give Nothing
getSeqX :: RegionState -> Int -> Maybe [Bool]
getSeqX EmptyR _ = Nothing
getSeqX (XRest itrvl bl) x = if inInt itrvl x
                                then Just bl
                             else Nothing
getSeqX (YRest itrvl bl) x = Just bl
getSeqX (XYUnion itrvlx itrvly blx bly) x = if inInt itrvlx x
                                               then Just blx
                                            else Just bly

getSeqY :: RegionState -> Int -> Maybe [Bool]
getSeqY EmptyR _ = Nothing
getSeqY (XRest itrvl bl) y = Just bl
getSeqY (YRest itrvl bl) y = if inInt itrvl y
                                then Just bl
                             else Nothing
getSeqY (XYUnion itrvlx itrvly blx bly) y = if inInt itrvly y
                                               then Just bly
                                            else Just blx

combine :: RegionState -> (Int, Interval, Interval) -> RegionState
combine EmptyR _ = EmptyR
combine rs (k,itrvlx, itrvly) =
    case (inInt itrvlx k, inInt itrvly k) of
         (False, False) -> EmptyR
         (True, False) -> reduce $ YRest yint seqx
         (False, True) -> reduce $ XRest xint seqy
         (True, True) -> reduce $ XYUnion xint yint seqy seqx
    where
        xinv = invX rs k -- in interval of ys
        yinv = invY rs k
        xint = yinv `iintersect` itrvlx
        yint = xinv `iintersect` itrvly
        seqx = False:(fromJust $ getSeqX rs k) --fromJust should only get evaluated if nothing
        seqy = True:(fromJust $ getSeqY rs k)


Consider the following problem: given an array $$$a$$$ containing $$$n$$$ integers (indexed from $$$0$$$ to $$$n-1$$$), find $$$\max\limits_{0 \leq l \leq r \leq n-1} \sum\limits_{l \leq i \leq r} (r-l+1) \cdot a_i$$$. In this problem, $$$1 \leq n \leq 2\,000$$$ and $$$|a_i| \leq 10^6$$$.In an attempt to solve the problem described, Alice quickly came up with a blazing-fast greedy algorithm and coded it. Her implementation in pseudocode is as follows:function find_answer(n, a)    # Assumes n is an integer between 1 and 2000, inclusive    # Assumes a is a list containing n integers: a[0], a[1], ..., a[n-1]    res = 0    cur = 0    k = -1    for i = 0 to i = n-1        cur = cur + a[i]        if cur < 0            cur = 0            k = i        res = max(res, (i-k)*cur)    return resAlso, as you can see, Alice's idea is not entirely correct. For example, suppose $$$n = 4$$$ and $$$a = [6, -8, 7, -42]$$$. Then, find_answer(n, a) would return $$$7$$$, but the correct answer is $$$3 \cdot (6-8+7) = 15$$$.You told Alice that her solution is incorrect, but she did not believe what you said.Given an integer $$$k$$$, you are to find any sequence $$$a$$$ of $$$n$$$ integers such that the correct answer and the answer produced by Alice's algorithm differ by exactly $$$k$$$. Note that although the choice of $$$n$$$ and the content of the sequence is yours, you must still follow the constraints earlier given: that $$$1 \leq n \leq 2\,000$$$ and that the absolute value of each element does not exceed $$$10^6$$$. If there is no such sequence, determine so.

The first and only line contains one integer $$$k$$$ ($$$1 \leq k \leq 10^9$$$).

If there is no sought sequence, print "-1". Otherwise, in the first line, print one integer $$$n$$$ ($$$1 \leq n \leq 2\,000$$$), denoting the number of elements in the sequence. Then, in the second line, print $$$n$$$ space-separated integers: $$$a_0, a_1, \ldots, a_{n-1}$$$ ($$$|a_i| \leq 10^6$$$).

NoteThe first sample corresponds to the example given in the problem statement.In the second sample, one answer is $$$n = 7$$$ with $$$a = [30, -12, -99, 123, -2, 245, -300]$$$, in which case find_answer(n, a) returns $$$1098$$$, while the correct answer is $$$1710$$$.

import Control.Applicative
import Control.Monad.Trans.State
import Data.Char
import Data.Function
import Data.Maybe

import qualified Data.ByteString.Lazy.Char8 as BS

-- {{{ Handy IO

type StringReader a = State BS.ByteString a

readFrom :: BS.ByteString -> StringReader a -> a
readFrom s = fst . flip runState s

isLineBreak :: Char -> Bool
isLineBreak c = c == '\n' || c == '\r'

stripLineBreak :: StringReader ()
stripLineBreak = do
  modify $ BS.dropWhile isLineBreak

getLine :: StringReader BS.ByteString
getLine = do
  s <- get
  let (l, s') = BS.span (not . isLineBreak) s
  put s'
  stripLineBreak
  return l

restLines :: StringReader [BS.ByteString]
restLines = do
  s <- get
  put BS.empty
  return $ BS.lines s

getInt :: Num a => StringReader a
getInt = do
  s <- get
  let l' = BS.dropWhile isSpace s
      (d, ll') = BS.span isDigit l'
  put ll'
  return $ case BS.readInt d of
    Just (i, _) -> fromIntegral i
    Nothing -> error $ "Not an integer: " ++ show d

-- }}}

-- {{{ Number theory

extGcd :: Int -> Int -> (Int, (Int, Int))
extGcd a 0 = (abs a, (if a < 0 then -1 else 1, 0))
extGcd a b = let (d, (x, y)) = extGcd b (a `mod` b)
  in (d, (y, x - (a `div` b) * y))

invMod :: Int -> Int -> (Int, Int)
invMod a m = let (d, (x, _)) = extGcd a m in (d, x)

normMod :: Int -> Int -> Int
normMod a m = let r = a `mod` m in if r < 0 then m + r else r

-- }}}

solve :: Int -> [Int]
solve k = fromMaybe [-1] (gen <$> maybeAns)
  where
    bound = 1000000 :: Int
    nBound = 2000 :: Int

    findSolution :: Int -> Int -> Maybe (Int, Int)
    findSolution n d
      | (k `mod` commonD) /= 0 = Nothing
      | (ceilDiv c d) > bound || (ceilDiv a b) > bound = Nothing
      | c == 0 || a == 0 = Nothing
      | otherwise = Just (a, c)
      where
        b = n - d
        (commonD, inv) = invMod n d
        c = normMod ((normMod (-k) d) * inv) d
        a = (k + n * c) `div` d

    ceilDiv x y = (x + y - 1) `div` y

    maybeAns = [(n, d) | d <- [1..nBound], n <- [(d + 1)..nBound]]
      & map (\(n, d) -> do
        (a, c) <- findSolution n d
        return (a, n - d, c, d))
      & foldl (<|>) Nothing

    gen (a, b, c, d) = part1 ++ part2
      where
        part1 = distribute c d & map negate
        part2 = distribute a b

    distribute a l =
      let r = a `mod` l in
      replicate (l - r) (a `div` l) ++ replicate r (ceilDiv a l)

main :: IO ()
main = do
  contents <- BS.getContents
  let k = readFrom contents getInt
  let ans = solve k
  print $ length ans
  ans & map show & unwords & putStrLn
  return ()

import Control.Applicative
import Control.Monad.Trans.State
import Data.Char
import Data.Function
import Data.Maybe

import qualified Data.ByteString.Lazy.Char8 as BS

-- {{{ Handy IO

type StringReader a = State BS.ByteString a

readFrom :: BS.ByteString -> StringReader a -> a
readFrom s = fst . flip runState s

isLineBreak :: Char -> Bool
isLineBreak c = c == '\n' || c == '\r'

stripLineBreak :: StringReader ()
stripLineBreak = do
  modify $ BS.dropWhile isLineBreak

getLine :: StringReader BS.ByteString
getLine = do
  s <- get
  let (l, s') = BS.span (not . isLineBreak) s
  put s'
  stripLineBreak
  return l

restLines :: StringReader [BS.ByteString]
restLines = do
  s <- get
  put BS.empty
  return $ BS.lines s

getInt :: Num a => StringReader a
getInt = do
  s <- get
  let l' = BS.dropWhile isSpace s
      (d, ll') = BS.span isDigit l'
  put ll'
  return $ case BS.readInt d of
    Just (i, _) -> fromIntegral i
    Nothing -> error $ "Not an integer: " ++ show d

-- }}}

-- {{{ Number theory

extGcd :: Int -> Int -> (Int, (Int, Int))
extGcd a 0 = (abs a, (if a < 0 then -1 else 1, 0))
extGcd a b = let (d, (x, y)) = extGcd b (a `mod` b)
  in (d, (y, x - (a `div` b) * y))

invMod :: Int -> Int -> (Int, Int)
invMod a m = let (d, (x, _)) = extGcd a m in (d, x)

normMod :: Int -> Int -> Int
normMod a m = let r = a `mod` m in if r < 0 then m + r else r

-- }}}

solve :: Int -> [Int]
solve k = fromMaybe [-1] (gen <$> maybeAns)
  where
    bound = 1000000 :: Int
    nBound = 2000 :: Int

    findSolution :: Int -> Int -> Maybe (Int, Int)
    findSolution n d
      | (k `mod` commonD) /= 0 = Nothing
      | (ceilDiv c d) > bound || (ceilDiv a b) > bound = Nothing
      | c == 0 || a == 0 = Nothing
      | otherwise = Just (a, c)
      where
        b = n - d
        (commonD, inv) = invMod n d
        c = normMod ((normMod (-k) d) * inv) d
        a = (k + n * c) `div` d

    ceilDiv x y = (x + y - 1) `div` y

    maybeAns = [(n, d) | d <- [1..nBound], n <- [(d + 1)..nBound]]
      & map (\(n, d) -> do
        (a, c) <- findSolution n d
        return (a, n - d, c, d))
      & foldl (<|>) Nothing

    gen (a, b, c, d) = part1 ++ part2
      where
        part1 = distribute c d & map negate
        part2 = distribute a b

    distribute a l =
      let r = a `mod` l in
      replicate (l - r) (a `div` l) ++ replicate r (ceilDiv a l)

main :: IO ()
main = do
  contents <- BS.getContents
  let k = readFrom contents getInt
  solve k & map show & unwords & putStrLn
  return ()


You are given the array of integer numbers a0, a1, ..., an - 1. For each element find the distance to the nearest zero (to the element which equals to zero). There is at least one zero element in the given array.

The first line contains integer n (1 ≤ n ≤ 2·105) — length of the array a. The second line contains integer elements of the array separated by single spaces ( - 109 ≤ ai ≤ 109).

Print the sequence d0, d1, ..., dn - 1, where di is the difference of indices between i and nearest j such that aj = 0. It is possible that i = j.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  B.putStr $ B.unwords $ map (B.pack . show) $ solve n xs

solve n xs = snd $ mapAccumL (\is i -> case is of { [i0] -> (is, abs $ i - i0); (i0:i1:_) -> if abs (i - i0) > abs (i - i1) then (tail is, abs (i - i1)) else (is, abs (i - i0)) } ) (map fst $ filter ((== 0) . snd) $ zip [1..] xs) [1..n]

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

module Main where
import Control.Monad
import Control.Applicative

inf = 1000000

f p x = if x == 0 then 0 else p + 1

main = do
    n <- read <$> getLine :: IO Int
    a <- map read . words <$> getLine :: IO [Int]
    let ans = zipWith min (tail $ scanl f inf a) (scanr (flip f) inf a)
    putStrLn $ unwords $ map show ans
    return ()

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (intercalate)

readInt = fst . M.fromJust . C.readInt

run i (x:xs) d | x == 0 = run 1 xs (0:d)
               | otherwise = run (i + 1) xs (i:d)
run _ [] d = d

main = do
    (readInt -> n) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ L.intercalate " " $ map show $ zipWith min (reverse (run n xs [])) (run n (reverse xs) [])


We just discovered a new data structure in our research group: a suffix three!It's very useful for natural language processing. Given three languages and three suffixes, a suffix three can determine which language a sentence is written in.It's super simple, 100% accurate, and doesn't involve advanced machine learning algorithms.Let us tell you how it works.  If a sentence ends with "po" the language is Filipino.  If a sentence ends with "desu" or "masu" the language is Japanese.  If a sentence ends with "mnida" the language is Korean. Given this, we need you to implement a suffix three that can differentiate Filipino, Japanese, and Korean.Oh, did I say three suffixes? I meant four.

The first line of input contains a single integer $$$t$$$ ($$$1 \leq t \leq 30$$$) denoting the number of test cases. The next lines contain descriptions of the test cases.  Each test case consists of a single line containing a single string denoting the sentence. Spaces are represented as underscores (the symbol "_") for ease of reading. The sentence has at least $$$1$$$ and at most $$$1000$$$ characters, and consists only of lowercase English letters and underscores. The sentence has no leading or trailing underscores and no two consecutive underscores. It is guaranteed that the sentence ends with one of the four suffixes mentioned above.

For each test case, print a single line containing either "FILIPINO", "JAPANESE", or "KOREAN" (all in uppercase, without quotes), depending on the detected language.

8
kamusta_po
genki_desu
ohayou_gozaimasu
annyeong_hashimnida
hajime_no_ippo
bensamu_no_sentou_houhou_ga_okama_kenpo
ang_halaman_doon_ay_sarisari_singkamasu
si_roy_mustang_ay_namamasu

FILIPINO
JAPANESE
JAPANESE
KOREAN
FILIPINO
FILIPINO
JAPANESE
JAPANESE

NoteThe first sentence ends with "po", so it is written in Filipino.The second and third sentences end with "desu" and "masu", so they are written in Japanese.The fourth sentence ends with "mnida", so it is written in Korean.

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        s <- getLine
        putStrLn $ solve s
            where solve s
                    | "po" `isSuffixOf` s = "FILIPINO"
                    | or ["desu" `isSuffixOf` s, "masu" `isSuffixOf` s] = "JAPANESE"
                    | otherwise = "KOREAN"

import Control.Monad
import Data.List

main = do
    n <- read <$> getLine
    replicateM_ n $ do
        s <- getLine
        putStrLn $ f s

f s | c == 'o' = "FILIPINO"
    | c == 'u' = "JAPANESE"
    | c == 'a' = "KOREAN"
  where
    c = last s

import Control.Monad

decide :: String -> String
decide s
  |l=='o' = "FILIPINO"
  |l=='a' = "KOREAN"
  |otherwise = "JAPANESE"
  where l = last s

routine :: IO ()
routine = do
  n <- getLine
  putStrLn $ decide n

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

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.Map as M
import Data.Maybe

process s | take 2 s == "op" = "FILIPINO"
	  | take 4 s == "used" = "JAPANESE"
	  | take 4 s =="usam" = "JAPANESE"
	  | otherwise = "KOREAN"

main = do
		getLine
		s<-map reverse <$> lines <$> getContents
		mapM_ putStrLn $ map process s

--ghc 7.10

data Language = UNKNOWN | FILIPINO | JAPANESE | KOREAN deriving (Show)

detectLanguage :: String -> Language
detectLanguage "po" = FILIPINO
detectLanguage "desu" = JAPANESE
detectLanguage "masu" = JAPANESE
detectLanguage "mnida" = KOREAN
detectLanguage (x:xs) = detectLanguage xs
detectLanguage _ = UNKNOWN

detectLanguages :: [String] -> [Language]
detectLanguages = map detectLanguage

main = do
    tStr <- getLine
    contents <- getContents
    let languages = words contents
    sequence . map print . detectLanguages $ languages


Phoenix has $$$n$$$ coins with weights $$$2^1, 2^2, \dots, 2^n$$$. He knows that $$$n$$$ is even.He wants to split the coins into two piles such that each pile has exactly $$$\frac{n}{2}$$$ coins and the difference of weights between the two piles is minimized. Formally, let $$$a$$$ denote the sum of weights in the first pile, and $$$b$$$ denote the sum of weights in the second pile. Help Phoenix minimize $$$|a-b|$$$, the absolute value of $$$a-b$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$2 \le n \le 30$$$; $$$n$$$ is even) — the number of coins that Phoenix has.

For each test case, output one integer — the minimum possible difference of weights between the two piles.

NoteIn the first test case, Phoenix has two coins with weights $$$2$$$ and $$$4$$$. No matter how he divides the coins, the difference will be $$$4-2=2$$$.In the second test case, Phoenix has four coins of weight $$$2$$$, $$$4$$$, $$$8$$$, and $$$16$$$. It is optimal for Phoenix to place coins with weights $$$2$$$ and $$$16$$$ in one pile, and coins with weights $$$4$$$ and $$$8$$$ in another pile. The difference is $$$(2+16)-(4+8)=6$$$.

module Main where

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

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

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

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

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

count :: (Eq a) => a -> [a] -> Int
count x = length . filter (== x)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let a = take n $ iterate (*2) 2
            rev_a = reverse a
        print $ abs
              $ (head rev_a + (sum $ take (n `div` 2 - 1) a))
                    - sum (drop (n `div` 2 - 1) . take (n - 1) $ a)

import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    n <- read <$> getLine
    print $
        sum
            [ if div n 2 <= i && i < n
                then -(2 ^ i)
                else 2 ^ i
            | i <- [1 .. n]
            ]

import Control.Monad

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

routine :: IO ()
routine = do
    n <- readLn
    print $ (2^((n `div` 2)+1)) - 2

solve :: Int -> Int
solve n =
    f - s
    where
        f = 2^n + sum [2^k | k <- [1 .. (div n 2 - 1)]]
        s = sum [2^k | k <- [div n 2 .. n - 1]]

handle_tests :: Int -> IO()
handle_tests 0 = do return ()
handle_tests t = do
    n <- getLine
    print . solve . read $ n
    handle_tests $ t - 1

main = do
    t <- getLine
    handle_tests (read t)

solve :: Int -> Int
solve n = 2 ^ (n `div` 2 + 1) - 2

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

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

process a= do
		let s = 2^(a+1)-2
		let s1 = 2^a +2^(div a 2)-2
		let s2 = s-s1
		print $ abs (s1-s2)
main = do
		n<- read <$> getLine ::IO Int
		a<-map read <$> replicateM n getLine ::IO [Int]
		mapM_ process a

main = interact $ unlines . map (show . solveFast . read) . tail . lines

solveFast :: Int->Int
solveFast x =(2^(x+1)-2)-2*(
               sum $
               take (x `div` 2) $
               drop 1 $
               cycle $
               reverse [2^n | n<-[1..x]])

process :: Int -> Int
process n = 2 ^ (n`div`2 + 1) - 2

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    xs <- fmap (map readInt.words) getContents
    mapM_ print $ map process $ xs

solution :: Integer -> Integer
solution n = (last numbers) + sum (take m numbers) - (sum $ drop m $ init numbers)
  where numbers = [2^i | i <- [1..n]]
        m = fromIntegral (div n 2) - 1

parser :: [String]-> [String]
parser rawNumbers = map show $ map solution numbers
  where (cases:numbers) = map read rawNumbers

main :: IO ()
main = interact (unlines . parser . lines)

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

process a= do
		let x = zip [2^i| i<-[1..a]] (cycle [1,2,2,1])
		let s = sum [2^i|i<-[1..a]]
		let s1 = sum $ map fst $ filter (\z-> snd z==1) x
		let s2 = s-s1
		print $ abs $ s1-s2

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

main = interact $ unlines . map (show . solveFast . read) . lines

solveFast :: Int->Int
solveFast x =(2^(x+1)-2)-2*(
               sum $
               take (x `div` 2) $
               drop 1 $
               cycle $
               reverse [2^n | n<-[1..x]])


Devu is a dumb guy, his learning curve is very slow. You are supposed to teach him n subjects, the ith subject has ci chapters. When you teach him, you are supposed to teach all the chapters of a subject continuously.Let us say that his initial per chapter learning power of a subject is x hours. In other words he can learn a chapter of a particular subject in x hours.Well Devu is not complete dumb, there is a good thing about him too. If you teach him a subject, then time required to teach any chapter of the next subject will require exactly 1 hour less than previously required (see the examples to understand it more clearly). Note that his per chapter learning power can not be less than 1 hour.You can teach him the n subjects in any possible order. Find out minimum amount of time (in hours) Devu will take to understand all the subjects and you will be free to do some enjoying task rather than teaching a dumb guy.Please be careful that answer might not fit in 32 bit data type.

The first line will contain two space separated integers n, x (1 ≤ n, x ≤ 105). The next line will contain n space separated integers: c1, c2, ..., cn (1 ≤ ci ≤ 105).

Output a single integer representing the answer to the problem.

NoteLook at the first example. Consider the order of subjects: 1, 2. When you teach Devu the first subject, it will take him 3 hours per chapter, so it will take 12 hours to teach first subject. After teaching first subject, his per chapter learning time will be 2 hours. Now teaching him second subject will take 2 × 1 = 2 hours. Hence you will need to spend 12 + 2 = 14 hours.Consider the order of subjects: 2, 1. When you teach Devu the second subject, then it will take him 3 hours per chapter, so it will take 3 × 1 = 3 hours to teach the second subject. After teaching the second subject, his per chapter learning time will be 2 hours. Now teaching him the first subject will take 2 × 4 = 8 hours. Hence you will need to spend 11 hours.So overall, minimum of both the cases is 11 hours.Look at the third example. The order in this example doesn't matter. When you teach Devu the first subject, it will take him 3 hours per chapter. When you teach Devu the second subject, it will take him 2 hours per chapter. When you teach Devu the third subject, it will take him 1 hours per chapter. In total it takes 6 hours.

{-# LANGUAGE NPlusKPatterns #-}

module Main where

import Data.List (sort)

main :: IO ()
main = do
    [n, x] <- getIntegers
    cs <- getIntegers
    print $ solve cs x

getIntegers :: IO [Integer]
getIntegers = do
    txt <- getLine -- String
    let ws = words txt -- [String]
    return $ fmap read ws -- [Integer]

countDown 1 = 1 : countDown 1
countDown (n + 1) = (n + 1) : countDown n

dot :: [Integer] -> [Integer] -> Integer
dot u v = dot' u v 0

dot' :: [Integer] -> [Integer] -> Integer -> Integer
dot' [] _ x = x
dot' _ [] x = x
dot' (a : as) (b : bs) x = dot' as bs (x + a * b)

solve :: [Integer] -> Integer -> Integer
solve cs x = sort cs `dot` countDown x

sortDecr :: Ord a => [a] -> [a]
sortDecr = reverse . sort

import Data.List

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

solve :: [Integer] -> Integer
solve (n:x:c) = solve' (sort c) x
    where
        solve' :: [Integer] -> Integer -> Integer
        solve' []     _ = 0
        solve' (c:cs) x = x * c + (solve' cs (max 1 (x - 1)))

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: Integer -> [Integer] -> Integer
solve x c = sum $ zipWith (*) (map (max 1) [x, x-1 ..]) (sort c)

main :: IO ()
main = do
  [n, x] <- map fromIntegral <$> getInts
  c <- map fromIntegral <$> getInts
  print $ solve x c

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List (sort, insertBy)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Debug.Trace

readInt64s :: B.ByteString -> [Int64]
readInt64s = map (fromIntegral . fst) . mapMaybe B.readInt . B.words

getInt64s :: IO [Int64]
getInt64s = readInt64s <$> B.getLine

main = do
  [_, x] <- getInt64s
  cs <- getInt64s
  let
    f c g t = c * t + g (max 1 (t-1))
   in print $ foldr f (const 0) (sort cs) x

import Data.List (sort)

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

solve :: [Integer] -> Integer
solve (_:x:cs) = sum $ zipWith (*) (sort cs) (map (max 1) [x, x-1..])
solve _ = undefined

import Data.List
main = interact $ show . solve . map read . tail . words
solve (x:cs) = sum $ zipWith (*) (iterate (max 1 . pred) x) $ sort cs

import Data.List

solve :: Integer -> [Integer] -> Integer
solve x [] = 0
solve x (a:b) = (a * x) + (solve (max (x - 1) 1) b)

main = do
        first <- getLine >>= (return . (map read) . words)
        second <- getLine >>= (return . sort . (map read) . words)
        putStrLn $ show $ solve (first !! 1) second

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

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  print $ solve x xs

solve :: Integer -> [Integer] -> Integer
solve x xs = sum.zipWith (*) (iterate (max 1.subtract 1) x) $ sort xs

import Data.List
s(_:x:l)=sum$zipWith(*)([x,x-1..1]++repeat 1)$sort l
main=interact$show.s.map read.words

import Data.List
main = do
    c:t:[] <- getLine >>= func
    l <- getLine >>= func
    print $ f t 0 $ sort l
        where func = return.(map read).words

f x acc (h:t) = f (if x==1 then 1 else (x-1)) (acc+x*h) t
f x acc [] = acc

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

main= do
	[n,m]<- map ( fst.fromJust.C.readInteger) .C.words <$> C.getLine::IO [Integer]
	s<-sort.map ( fst.fromJust.C.readInteger) .C.words <$> C.getLine::IO [Integer]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))

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

main= do
	[n,m]<- map read .words <$> getLine::IO [Integer]
	s<-sort.map read .words <$> getLine::IO [Integer]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))

import Data.List

main = do
    let i = fmap (map read . words) getLine :: IO [Integer]
    [n, x] <- i
    c <- fmap sort i
    print $ gao c x

gao :: [Integer] -> Integer -> Integer
gao [] _ = 0
gao (x:xs) t = x * t + (gao xs $ max 1 (t - 1))

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: Integer -> [Integer] -> Integer
solve x c = sum $ zipWith (*) [x, x-1 ..] (sort c)

main :: IO ()
main = do
  [n, x] <- map fromIntegral <$> getInts
  c <- map fromIntegral <$> getInts
  print $ solve x c

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

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

main= do
	[n,m]<- map read .words <$> getLine::IO [Int]
	s<-sort.map read .words <$> getLine::IO [Int]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))


A boy named Vasya has taken part in an Olympiad. His teacher knows that in total Vasya got at least x points for both tours of the Olympiad. The teacher has the results of the first and the second tour of the Olympiad but the problem is, the results have only points, no names. The teacher has to know Vasya's chances.Help Vasya's teacher, find two numbers — the best and the worst place Vasya could have won. Note that the total results' table sorts the participants by the sum of points for both tours (the first place has the participant who has got the most points). If two or more participants have got the same number of points, it's up to the jury to assign places to them according to their choice. It is guaranteed that each participant of the Olympiad participated in both tours of the Olympiad.

The first line contains two space-separated integers n, x (1 ≤ n ≤ 105; 0 ≤ x ≤ 2·105) — the number of Olympiad participants and the minimum number of points Vasya earned. The second line contains n space-separated integers: a1, a2, ..., an (0 ≤ ai ≤ 105) — the participants' points in the first tour. The third line contains n space-separated integers: b1, b2, ..., bn (0 ≤ bi ≤ 105) — the participants' points in the second tour. The participants' points are given in the arbitrary order. It is guaranteed that Vasya was present in the Olympiad — there are two integers i, j (1 ≤ i, j ≤ n) such, that ai + bj ≥ x.

Print two space-separated integers — the best and the worst place Vasya could have got on the Olympiad.

NoteIn the first text sample all 5 participants earn 2 points each in any case. Depending on the jury's decision, Vasya can get the first (the best) as well as the last (the worst) fifth place.In the second test sample in the best case scenario Vasya wins again: he can win 12 points and become the absolute winner if the total results' table looks like that — {4:8, 6:4, 3:6, 4:4, 4:3, 5:0}.In this table all participants are sorted by decreasing points and we can see how much a participant earned in the first and in the second tour.In the worst case scenario Vasya can get the fifth place if the table looks like that — {4:8, 4:6, 6:4, 5:4, 4:3, 3:0}, and he earned 4 and 3 points in the first and second tours, correspondingly.

{-# LANGUAGE BangPatterns #-}

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

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

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ !ans = ans
      solve (x:xs) yys@(y:ys) !ans
        | xy>=val = solve xs ys $! ans+1
        | otherwise = solve xs yys ans
       where
         !xy = x+y
  putStr"1 "
  print $ solve tour1 tour2 0

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

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

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ ans = ans
      solve (x:xs) (y:ys) ans
        | x+y>=val = solve xs ys $! ans+1
        | otherwise = solve xs (y:ys) ans
  putStr"1 "
  print $ solve tour1 tour2 0

{-# LANGUAGE BangPatterns #-}
import Data.Array.Base
import Data.Array.ST (STUArray,runSTUArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Monad
import Control.Monad.ST

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

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- radixSort.map readInt.B.words <$> B.getLine
  tour2 <- reverse.radixSort.map readInt.B.words <$> B.getLine
  let solve [] _ !ans = ans
      solve (x:xs) yys@(y:ys) !ans
        | xy>=val = solve xs ys $! ans+1
        | otherwise = solve xs yys ans
       where
         !xy = x+y
  putStr"1 "
  print $ solve tour1 tour2 0

radixSort :: [Int] -> [Int]
radixSort xs = elems $ runSTUArray $ do

  let mask = 0xffff
      n = length xs

  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i->do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`shiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i->do
    xi <- unsafeRead tmp i
    let !mi = (xi`shiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

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

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

main = do
  [n,val] <- map read.words <$> getLine
  (max1:tour1) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  (max2:tour2) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] [] ans = ans
      solve (x:xs) (y:ys) ans
        | x+max2>=val && y+max1>=val = solve xs ys $! ans+1
        | otherwise = ans
  putStr"1 "
  print $ solve tour1 tour2 1

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

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

main = do
  [n,x] <- map read.words <$> getLine
  tour1 <- map readInt.B.words <$> B.getLine
  tour2 <- map readInt.B.words <$> B.getLine
  let worst = length.takeWhile (>=x).sortBy (flip compare) $ zipWith (+) tour1 tour2
  putStrLn.unwords.map show $ [1,worst]

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

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

main = do
  [n,x] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sort.map readInt.B.words <$> B.getLine
  let max1 = maximum tour1
      max2 = maximum tour2
      ans1 = length $ dropWhile (<x-max2) tour1
      ans2 = length $ dropWhile (<x-max1) tour2
  putStr"1 "
  print $ min ans1 ans2

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

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

main = do
  [n,val] <- map read.words <$> getLine
  (max1:tour1) <- sort.map readInt.B.words <$> B.getLine
  (max2:tour2) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ ans = ans
      solve (x:xs) (y:ys) ans
        | x+y>=val = solve xs ys $! ans+1
        | otherwise = solve xs (y:ys) ans
  putStr"1 "
  print $ solve tour1 tour2 1


The last contest held on Johnny's favorite competitive programming platform has been received rather positively. However, Johnny's rating has dropped again! He thinks that the presented tasks are lovely, but don't show the truth about competitors' skills.The boy is now looking at the ratings of consecutive participants written in a binary system. He thinks that the more such ratings differ, the more unfair is that such people are next to each other. He defines the difference between two numbers as the number of bit positions, where one number has zero, and another has one (we suppose that numbers are padded with leading zeros to the same length). For example, the difference of $$$5 = 101_2$$$ and $$$14 = 1110_2$$$ equals to $$$3$$$, since $$$0101$$$ and $$$1110$$$ differ in $$$3$$$ positions. Johnny defines the unfairness of the contest as the sum of such differences counted for neighboring participants.Johnny has just sent you the rating sequence and wants you to find the unfairness of the competition. You have noticed that you've got a sequence of consecutive integers from $$$0$$$ to $$$n$$$. That's strange, but the boy stubbornly says that everything is right. So help him and find the desired unfairness for received numbers.

The input consists of multiple test cases. The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10\,000$$$) — the number of test cases. The following $$$t$$$ lines contain a description of test cases. The first and only line in each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^{18})$$$.

Output $$$t$$$ lines. For each test case, you should output a single line with one integer — the unfairness of the contest if the rating sequence equals to $$$0$$$, $$$1$$$, ..., $$$n - 1$$$, $$$n$$$.

NoteFor $$$n = 5$$$ we calculate unfairness of the following sequence (numbers from $$$0$$$ to $$$5$$$ written in binary with extra leading zeroes, so they all have the same length):   $$$000$$$  $$$001$$$  $$$010$$$  $$$011$$$  $$$100$$$  $$$101$$$ The differences are equal to $$$1$$$, $$$2$$$, $$$1$$$, $$$3$$$, $$$1$$$ respectively, so unfairness is equal to $$$1 + 2 + 1 + 3 + 1 = 8$$$.

unfair n = sum [n `div` (2^d) | d <- takeWhile (\x -> (2^x <= n))[0..]]
readIntList :: Integer -> IO [Integer]
readIntList 0 = return []
readIntList k = do
    val <- read <$> getLine
    (\li -> val:li) <$> (readIntList (k-1))
main = do
    t <- read <$> getLine
    li <- readIntList t
    sequence $ map (putStrLn . show . unfair) li

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

routine :: IO ()
routine = do
    n <- readLn
    print $ solve n

solve :: Integer -> Integer
solve n = f n 1 0
    where
        f n pwr acc = if pwr>n then acc else f n (pwr*2) (acc + (n `div` pwr))

module Main where
    import Data.Bits

    solve :: IO ()
    solve = do
        s <- getLine
        let n = read s :: Integer
        print $ 2 * n - fromIntegral (popCount n)

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter (n - 1)

    main :: IO ()
    main = do
        s <- getLine
        let q = read s :: Integer
        iter q

{-# LANGUAGE LambdaCase #-}
{-# 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 [] ""

(|>) = flip ($)

_solve !acc 0 = acc
_solve !acc !curr = _solve (acc + curr) (curr `div` 2)
solve = _solve (0 :: Integer)

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Integer]
      res = vals |> unfoldr (\case
        []      -> Nothing
        n:rest  -> Just (solve n, rest)
        )
  sequence_ (putStrLn . show <$> res)

toBin :: Integer -> [Bool]
toBin n
  | n == 0 = []
  | mod n 2 == 0 = toBin(div n 2) ++ [False]
  | otherwise = toBin(div n 2) ++ [True]

solve :: Integer -> Integer
solve n = foldl (\acc (k, s) -> acc + (if s then 2^(k+1)-1 else 0)) 0 $ zip [0..] bin
  where bin = reverse $ toBin n

parse :: String -> String
parse input = show $ solve n
  where n = read input :: Integer

main :: IO ()
main = interact (unlines . map parse . tail . lines)

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

routine :: IO ()
routine = do
    n <- readLn
    print $ solve n

solve :: Int -> Int
solve n = f n 1 0
    where
        f n pwr acc = if pwr>n then acc else f n (pwr*2) (acc + (n `div` pwr))


Monocarp and Polycarp are learning new programming techniques. Now they decided to try pair programming.It's known that they have worked together on the same file for $$$n + m$$$ minutes. Every minute exactly one of them made one change to the file. Before they started, there were already $$$k$$$ lines written in the file.Every minute exactly one of them does one of two actions: adds a new line to the end of the file or changes one of its lines.Monocarp worked in total for $$$n$$$ minutes and performed the sequence of actions $$$[a_1, a_2, \dots, a_n]$$$. If $$$a_i = 0$$$, then he adds a new line to the end of the file. If $$$a_i > 0$$$, then he changes the line with the number $$$a_i$$$. Monocarp performed actions strictly in this order: $$$a_1$$$, then $$$a_2$$$, ..., $$$a_n$$$.Polycarp worked in total for $$$m$$$ minutes and performed the sequence of actions $$$[b_1, b_2, \dots, b_m]$$$. If $$$b_j = 0$$$, then he adds a new line to the end of the file. If $$$b_j > 0$$$, then he changes the line with the number $$$b_j$$$. Polycarp performed actions strictly in this order: $$$b_1$$$, then $$$b_2$$$, ..., $$$b_m$$$.Restore their common sequence of actions of length $$$n + m$$$ such that all actions would be correct — there should be no changes to lines that do not yet exist. Keep in mind that in the common sequence Monocarp's actions should form the subsequence $$$[a_1, a_2, \dots, a_n]$$$ and Polycarp's — subsequence $$$[b_1, b_2, \dots, b_m]$$$. They can replace each other at the computer any number of times.Let's look at an example. Suppose $$$k = 3$$$. Monocarp first changed the line with the number $$$2$$$ and then added a new line (thus, $$$n = 2, \: a = [2, 0]$$$). Polycarp first added a new line and then changed the line with the number $$$5$$$ (thus, $$$m = 2, \: b = [0, 5]$$$).Since the initial length of the file was $$$3$$$, in order for Polycarp to change line number $$$5$$$ two new lines must be added beforehand. Examples of correct sequences of changes, in this case, would be $$$[0, 2, 0, 5]$$$ and $$$[2, 0, 0, 5]$$$. Changes $$$[0, 0, 5, 2]$$$ (wrong order of actions) and $$$[0, 5, 2, 0]$$$ (line $$$5$$$ cannot be edited yet) are not correct.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$). Then $$$t$$$ test cases follow. Before each test case, there is an empty line. Each test case contains three lines. The first line contains three integers $$$k$$$, $$$n$$$, $$$m$$$ ($$$0 \le k \le 100$$$, $$$1 \le n, m \le 100$$$) — the initial number of lines in file and lengths of Monocarp's and Polycarp's sequences of changes respectively. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 300$$$). The third line contains $$$m$$$ integers $$$b_1, b_2, \dots, b_m$$$ ($$$0 \le b_j \le 300$$$).

For each test case print any correct common sequence of Monocarp's and Polycarp's actions of length $$$n + m$$$ or -1 if such sequence doesn't exist.

import Control.Monad (replicateM_)

pairProgSingle :: Int -> [Int] -> [Int]
pairProgSingle _ [] = []
pairProgSingle k (x : xs)
  | x == 0 = x : pairProg (k + 1) xs []
  | x <= k = x : pairProg k xs []
  | otherwise = []

pairProg :: Int -> [Int] -> [Int] -> [Int]
pairProg _ [] [] = []
pairProg k xs [] = pairProgSingle k xs
pairProg k [] ys = pairProgSingle k ys
pairProg k (x : xs) (y : ys)
  | x > 0 && y > 0 = if x > k && y > k then []
      else if x > k then y : pairProg k (x : xs) ys
      else x : pairProg k xs (y : ys)
  | x == 0 && y == 0 = x : y : pairProg (k + 2) xs ys
  | y == 0 = if x <= k then x : pairProg k xs (y : ys) else y : pairProg (k + 1) (x : xs) ys
  | x == 0 = if y <= k then y : pairProg k (x : xs) ys else x : pairProg (k + 1) xs (y : ys)

solve :: (Int, Int, Int) -> [Int] -> [Int] -> [Int]
solve (k, n, m) xs ys = if n + m == length prog then prog else [-1] where
  prog = pairProg k xs ys

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    [k, n, m] <- readInts
    xs <- readInts
    ys <- readInts
    putStrLn $ unwords $ map show $ solve (k, n, m) xs ys

module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    getLine
    [k, n, m] <- getIntList
    a <- getIntList
    b <- getIntList
    printList $ reverse $ f a b [] k

f :: [Int] -> [Int] -> [Int] -> Int -> [Int]
f []    [] o _ = o
f (x:a) [] o k
    | x == 0    = f a [] (x:o) (k+1)
    | x <= k    = f a [] (x:o) k
    | otherwise = [-1]
f [] (y:b) o k
    | y == 0    = f [] b (y:o) (k+1)
    | y <= k    = f [] b (y:o) k
    | otherwise = [-1]
f (x:a) (y:b) o k
    | x == 0    = f a (y:b) (x:o) (k+1)
    | y == 0    = f (x:a) b (y:o) (k+1)
    | x <= k    = f a (y:b) (x:o) k
    | y <= k    = f (x:a) b (y:o) k
    | otherwise = [-1]

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

good :: Int -> [Int] -> [Int] -> [Int]
good _ [] [] = []
good k [] (x:xs)
  | x > k = [-1]
  | x == 0 = x : good (k+1) [] xs
  | otherwise = x : good k [] xs
good k a [] = good k [] a
good k a@(x:xs) b@(y:ys)
  | x == 0 = x: good (k+1) xs b
  | y == 0 = y: good (k+1) a ys
  | x <= k = x: good k xs b
  | y <= k = y: good k a ys
  | otherwise = [-1]

solve :: IO ()
solve = do
  [_, s, sa, sb] <- sequence $ replicate 4 getLine
  let [k, n, m] = readInts s
      a = readInts sa
      b = readInts sb
      l = good k a b
      bad = any (<0) l
    in putStrLn (if bad then "-1" else intercalate " " $ map show l)
  where readInts st = map read $ words st :: [Int]

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

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

solve [] [] k = []
solve [] (m:ms) k
                |m == 0 = m : solve [] ms (k+1)
                |m > 0 && k >= m = m : solve [] ms k
                |otherwise = [-1]
solve ns [] k = solve [] ns k
solve (n:ns) (m:ms) k
                    | n == 0 = n : solve ns (m:ms) (k+1)
                    | m == 0 = m : solve (n:ns) ms (k+1)
                    | n > 0 && k >= n = n : solve ns (m:ms) k
                    | m > 0 && k >= m = m : solve (n:ns) ms k
                    | otherwise = [-1]

printResult = do
    nothing <- getLine
    [k,n,m] <- readInts
    ns <- readInts
    ms <- readInts
    let r = solve ns ms k
    if last r == -1 then putStrLn "-1"
    else putStrLn . unwords . map show $ r
main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

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

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

main :: IO ()
main =
  interact $
    lines >>> drop 1 >>> chunksOf 4
      >>> map (drop 1 >>> map (words >>> map read) >>> solve
               >>> fmap (map show >>> unwords) >>> fromMaybe "-1")
      >>> unlines

solve :: [[Int]] -> Maybe [Int]
solve [[k,_,_], xs, ys] = build k xs ys

build :: Int -> [Int] -> [Int] -> Maybe [Int]
build _ [] [] = Just []
build k (x:xs) [] = when (x <= k) $ (x:) <$> build (updK k x) xs []
build k [] ys = build k ys []
build k (x:xs) (y:ys)
  | x <= k = (x:) <$> build (updK k x) xs (y:ys)
  | y <= k = (y:) <$> build (updK k y) (x:xs) ys
  | otherwise = Nothing

updK :: Int -> Int -> Int
updK k 0 = k + 1
updK k _ = k

when :: Bool -> Maybe a -> Maybe a
when True ma = ma
when False _ = Nothing


Maxim wants to buy some games at the local game shop. There are $$$n$$$ games in the shop, the $$$i$$$-th game costs $$$c_i$$$.Maxim has a wallet which can be represented as an array of integers. His wallet contains $$$m$$$ bills, the $$$j$$$-th bill has value $$$a_j$$$.Games in the shop are ordered from left to right, Maxim tries to buy every game in that order.When Maxim stands at the position $$$i$$$ in the shop, he takes the first bill from his wallet (if his wallet is empty then he proceeds to the next position immediately) and tries to buy the $$$i$$$-th game using this bill. After Maxim tried to buy the $$$n$$$-th game, he leaves the shop.Maxim buys the $$$i$$$-th game if and only if the value of the first bill (which he takes) from his wallet is greater or equal to the cost of the $$$i$$$-th game. If he successfully buys the $$$i$$$-th game, the first bill from his wallet disappears and the next bill becomes first. Otherwise Maxim leaves the first bill in his wallet (this bill still remains the first one) and proceeds to the next game.For example, for array $$$c = [2, 4, 5, 2, 4]$$$ and array $$$a = [5, 3, 4, 6]$$$ the following process takes place: Maxim buys the first game using the first bill (its value is $$$5$$$), the bill disappears, after that the second bill (with value $$$3$$$) becomes the first one in Maxim's wallet, then Maxim doesn't buy the second game because $$$c_2 > a_2$$$, the same with the third game, then he buys the fourth game using the bill of value $$$a_2$$$ (the third bill becomes the first one in Maxim's wallet) and buys the fifth game using the bill of value $$$a_3$$$.Your task is to get the number of games Maxim will buy.

The first line of the input contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1000$$$) — the number of games and the number of bills in Maxim's wallet. The second line of the input contains $$$n$$$ integers $$$c_1, c_2, \dots, c_n$$$ ($$$1 \le c_i \le 1000$$$), where $$$c_i$$$ is the cost of the $$$i$$$-th game. The third line of the input contains $$$m$$$ integers $$$a_1, a_2, \dots, a_m$$$ ($$$1 \le a_j \le 1000$$$), where $$$a_j$$$ is the value of the $$$j$$$-th bill from the Maxim's wallet.

Print a single integer — the number of games Maxim will buy.

NoteThe first example is described in the problem statement.In the second example Maxim cannot buy any game because the value of the first bill in his wallet is smaller than the cost of any game in the shop.In the third example the values of the bills in Maxim's wallet are large enough to buy any game he encounter until he runs out of bills in his wallet.

import Data.List

toint s = (read s) :: Integer

doit2 [] y = (0, [])
doit2 (x:xs) y =
    if x >= y then
        (1,xs)
    else
        let (t, a) = doit2 xs y in
        (t,x:a)

doit [] a r = r
doit a [] r = r
doit (x:xs) (a:as) r =
    if a >= x then
        doit xs as $ r+1
    else
        doit xs (a:as) r
    --let (t,aa) = doit2 a x in
    --doit xs aa $ r+t

solve::String -> String
solve sss =
    let (n:m:ss) = map toint $ words sss in
    let c = take (fromIntegral n) ss in
    let a = drop (fromIntegral n) ss in
    (show (doit c a 0)) ++ "\n"

main = do
  interact $ solve

import Data.List

f::[Int]->[Int]->Int
f [] _ =0
f _ []=0
f (x:xs) (y:ys)
      |x>y=f xs (y:ys)
      |otherwise=1 + (f xs ys)

main = do
       e<-getLine
       e2<-getLine
       e3<-getLine
       let xs=map read (words e2)::[Int]
           ys=map read (words e3)::[Int]
       print $ f xs ys

import Data.Functor

solve :: [Int] -> [Int] -> Int
solve (c:cs) (a:as) | a >= c = 1 + solve cs as
                    | otherwise = solve cs (a:as)
solve _ _ = 0

main :: IO ()
main = do
    getLine
    c <- map read <$> words <$> getLine
    a <- map read <$> words <$> getLine
    print $ solve c a

solve (x:xs) (y:ys) | y >= x = 1 + solve xs ys
                    | 1>0 = solve xs (y:ys)
solve _ _ = 0
main = do
    getLine
    g <- map read . words <$> getLine
    b <- map read . words <$> getLine :: IO [Int]
    print $ solve g b

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve (x:xs) (y:ys) = if y >= x then 1 + solve xs ys
                                else solve xs (y:ys)
main = do
    l1 <- getLine :: IO String
    l2 <- getLine :: IO String
    l3 <- getLine :: IO String
    let [n,m] = map read $ words l1 :: [Int]
    let games = map read $ words l2 :: [Int]
    let bills = map read $ words l3 :: [Int]
    --print $ bills
    print $ solve games bills

solve (x:xs) (y:ys) = if y >= x then 1 + solve xs ys else solve xs (y:ys)
solve _ _ = 0
main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    games <- map read . words <$> getLine
    bills <- map read . words <$> getLine :: IO [Int]
    print $ solve games bills

import           Control.Applicative

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    cs <- map read.words <$> getLine
    bs <- map read.words <$> getLine
    print $ solve cs bs

solve :: [Int] -> [Int] -> Int
solve cs bs = go 0 cs bs
  where
    go res (c:cs) (b:bs)
      | c <= b = go (res + 1) cs bs
      | otherwise = go res cs (b:bs)
    go res _ _ = res

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

process n [] _ = n
process n _ [] = n
process n (c:cs) (a:as) | c<=a = process (n+1) cs as
                        | otherwise = process n cs (a:as)

main = do
		getLine
		c<-map read <$> words <$> getLine ::IO [Int]
		a<-map read <$> words <$> getLine ::IO [Int]
		print $ process 0 c a

process :: Integral a => [a] -> [a]-> Int
process (c:cs) as'@(a:as)
    | c > a = process cs as'
    | otherwise = 1+process cs as
process _ _ = 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,m] <- fmap (map readInt.words) getLine
    cs <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    print $ process cs as


Suppose you have an integer $$$v$$$. In one operation, you can:   either set $$$v = (v + 1) \bmod 32768$$$  or set $$$v = (2 \cdot v) \bmod 32768$$$. You are given $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$. What is the minimum number of operations you need to make each $$$a_i$$$ equal to $$$0$$$?

The first line contains the single integer $$$n$$$ ($$$1 \le n \le 32768$$$) — the number of integers. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i < 32768$$$).

Print $$$n$$$ integers. The $$$i$$$-th integer should be equal to the minimum number of operations required to make $$$a_i$$$ equal to $$$0$$$.

NoteLet's consider each $$$a_i$$$:   $$$a_1 = 19$$$. You can, firstly, increase it by one to get $$$20$$$ and then multiply it by two $$$13$$$ times. You'll get $$$0$$$ in $$$1 + 13 = 14$$$ steps.  $$$a_2 = 32764$$$. You can increase it by one $$$4$$$ times: $$$32764 \rightarrow 32765 \rightarrow 32766 \rightarrow 32767 \rightarrow 0$$$.  $$$a_3 = 10240$$$. You can multiply it by two $$$4$$$ times: $$$10240 \rightarrow 20480 \rightarrow 8192 \rightarrow 16384 \rightarrow 0$$$.  $$$a_4 = 49$$$. You can multiply it by two $$$15$$$ times.

import Control.Monad
import Data.Maybe
import Data.Array
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

putInts :: [Int] -> Builder
putInts [] = charUtf8 '\n'
putInts (x : xs) = intDec x <> charUtf8 ' ' <> putInts xs

n :: Int
n = 32768

calc :: Array Int Int -> Array Int Int
calc a = listArray (0, n - 1) [min (a ! x) (func x) | x <- [0 .. n - 1]]
  where func x = let x' = (x + 1) `mod` n
                     x'' = (x * 2) `mod` n
                 in 1 + min (a ! x') (a ! x'')

main :: IO ()
main = do
  let Left dp = foldM iter (listArray (0, n - 1) $ 0 : [n - 1, n - 2 .. 1]) $ repeat ()
      iter a _ = let a' = calc a in if a' == a then Left a else Right a'
  _ <- getInts
  as <- getInts
  hPutBuilder stdout $ putInts $ map (dp !) as


Alice and Bob play a game. There is a paper strip which is divided into n + 1 cells numbered from left to right starting from 0. There is a chip placed in the n-th cell (the last one).Players take turns, Alice is first. Each player during his or her turn has to move the chip 1, 2 or k cells to the left (so, if the chip is currently in the cell i, the player can move it into cell i - 1, i - 2 or i - k). The chip should not leave the borders of the paper strip: it is impossible, for example, to move it k cells to the left if the current cell has number i < k. The player who can't make a move loses the game.Who wins if both participants play optimally?Alice and Bob would like to play several games, so you should determine the winner in each game.

The first line contains the single integer T (1 ≤ T ≤ 100) — the number of games. Next T lines contain one game per line. All games are independent. Each of the next T lines contains two integers n and k (0 ≤ n ≤ 109, 3 ≤ k ≤ 109) — the length of the strip and the constant denoting the third move, respectively.

For each game, print Alice if Alice wins this game and Bob otherwise.

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod (n + 1) (k + 1) == 0 || mod (mod n (k + 1)) 3 /= 0
           | otherwise    = mod n 3 /= 0

import Control.Monad (replicateM_)
import Data.Char (ord)

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

parseInts = fmap parseInt . words

solve [n, k]
  | k `mod` 3 /= 0 =
    if n `mod` 3 == 0
      then bob
      else alice
  | otherwise =
    let r = n `mod` (k + 1)
     in if r == k
          then alice
          else if r `mod` 3 == 0
                 then bob
                 else alice
  where
    alice = "Alice"
    bob = "Bob"

main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum (putStrLn . solve . parseInts =<< getLine)

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod n (4 * k) == 3 * k || mod n 3 /= mod (mod (div n k) 4) 3
           | otherwise    = mod n 3 /= 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod (mod n (k + 1)) 3 /= 0
           | otherwise    = mod n 3 /= 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Bob"
winner False = "Alice"

answer n k | mod k 3 == 0 && n >= k = mod n 3 == 1
           | otherwise             = mod n 3 == 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = (n > 0 && mod n k == 0) || mod n 3 /= mod (div n k) 3
           | otherwise    = mod n 3 /= 0


Lolek and Bolek are about to travel abroad by plane. The local airport has a special "Choose Your Plane" offer. The offer's conditions are as follows:  it is up to a passenger to choose a plane to fly on;  if the chosen plane has x (x > 0) empty seats at the given moment, then the ticket for such a plane costs x zlotys (units of Polish currency). The only ticket office of the airport already has a queue of n passengers in front of it. Lolek and Bolek have not stood in the queue yet, but they are already wondering what is the maximum and the minimum number of zlotys the airport administration can earn if all n passengers buy tickets according to the conditions of this offer?The passengers buy tickets in turn, the first person in the queue goes first, then goes the second one, and so on up to n-th person.

The first line contains two integers n and m (1 ≤ n, m ≤ 1000) — the number of passengers in the queue and the number of planes in the airport, correspondingly. The next line contains m integers a1, a2, ..., am (1 ≤ ai ≤ 1000) — ai stands for the number of empty seats in the i-th plane before the ticket office starts selling tickets. The numbers in the lines are separated by a space. It is guaranteed that there are at least n empty seats in total.

Print two integers — the maximum and the minimum number of zlotys that the airport administration can earn, correspondingly.

NoteIn the first test sample the number of passengers is equal to the number of empty seats, so regardless of the way the planes are chosen, the administration will earn the same sum.In the second sample the sum is maximized if the 1-st person in the queue buys a ticket to the 1-st plane, the 2-nd person — to the 2-nd plane, the 3-rd person — to the 3-rd plane, the 4-th person — to the 1-st plane. The sum is minimized if the 1-st person in the queue buys a ticket to the 1-st plane, the 2-nd person — to the 1-st plane, the 3-rd person — to the 2-nd plane, the 4-th person — to the 2-nd plane.

import List (sort)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

solve :: Int -> [Int] -> (Int, Int)
solve n as  =  (mx, mn)
  where
    mx  =  calcMax (reverse (sort as)) n 0
    calcMax _ 0 acc  =  acc
    calcMax [] _ _  =  undefined
    calcMax (a:as) n acc  =  calcMax (reverse (sort ((a-1):as))) (n-1) (acc+a)
    mn  =  calcMin (sort as) n 0
    calcMin _ 0 acc  =  acc
    calcMin [] _ _  =  undefined
    calcMin (a:as) n acc
      | a == 0  =  calcMin as n acc
      | otherwise  =  calcMin (a-1:as) (n-1) (acc+a)

printAns :: (Int, Int) -> IO ()
printAns (x,y)  =  putStrLn $ concat [show x, " ", show y]

main :: IO ()
main  =  do
    [n, m]  <-  reads
    as  <-  reads
    printAns $ solve n as

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import qualified Data.Set as S

main = do
  [n,m] <- map read.words <$> getLine
  pqueue <- S.fromList.(`zip`[1..m]).map read.words <$> getLine
  let solvemax 0 !ans !pq = ans
      solvemax !rest !ans !pq
        | cost == 0 = solvemax rest ans q
        | otherwise =  solvemax (rest-1) (ans+cost) (S.insert (cost-1,i) q)
       where
         ((cost,i),q) = S.deleteFindMax pq
      solvemin 0 !ans !pq = ans
      solvemin !rest !ans !pq
        | cost == 0 = solvemin rest ans q
        | otherwise = solvemin (rest-1) (ans+cost) (S.insert (cost-1,i) q)
       where
         ((cost,i),q) = S.deleteFindMin pq
  putStrLn . unwords $ map show [solvemax n 0 pqueue,solvemin n 0 pqueue]

import Data.List

readInt s    = read s :: Int
readInts s n = map readInt $ take n $ words s
progr low high = (high - low + 1) * (low + high) `div` 2

minIncome n as = calcIncome n . sort $ as
    where calcIncome n all@(a:as)
            | n == 0    = 0
            | n <= a    = progr (a - n + 1) a
            | otherwise = progr 1 a + calcIncome (n - a) as

maxIncome n as = calcIncome n (rsort as)
    where rsort = reverse . sort
          calcIncome n (cur : as)
             | n == 0    = 0
             | otherwise = let next = if null as then 1 else head as
                               getting = min n (cur - next + 1)
                               curres = progr (cur - getting + 1) cur
                               nextres = calcIncome (n - getting) (rsort $ (cur - getting) : as)
                            in curres + nextres

main = do
    args0 <- getLine
    args1 <- getLine
    let [n, m] = readInts args0 2
        as     = readInts args1 m
    putStrLn . intercalate " " . map show $ [maxIncome n as, minIncome n as]

import Data.List

readInt s    = read s :: Int
readInts s n = map readInt $ take n $ words s
progr low high = (high - low + 1) * (low + high) `div` 2

minIncome n as = calcIncome n . sort $ as
    where calcIncome n all@(a:as)
            | n == 0    = 0
            | n <= a    = progr 1 n
            | otherwise = progr 1 a + calcIncome (n - a) as

maxIncome n as = calcIncome n (rsort as)
    where rsort = reverse . sort
          calcIncome n (cur : as)
             | n == 0    = 0
             | otherwise = let next = if null as then 1 else head as
                               getting = min n (cur - next + 1)
                               curres = progr (cur - getting + 1) cur
                               nextres = calcIncome (n - getting) (rsort $ (cur - getting) : as)
                            in curres + nextres

main = do
    args0 <- getLine
    args1 <- getLine
    let [n, m] = readInts args0 2
        as     = readInts args1 m
    putStrLn . intercalate " " . map show $ [maxIncome n as, minIncome n as]


Iahub is so happy about inventing bubble sort graphs that he's staying all day long at the office and writing permutations. Iahubina is angry that she is no more important for Iahub. When Iahub goes away, Iahubina comes to his office and sabotage his research work.The girl finds an important permutation for the research. The permutation contains n distinct integers a1, a2, ..., an (1 ≤ ai ≤ n). She replaces some of permutation elements with -1 value as a revenge. When Iahub finds out his important permutation is broken, he tries to recover it. The only thing he remembers about the permutation is it didn't have any fixed point. A fixed point for a permutation is an element ak which has value equal to k (ak = k). Your job is to proof to Iahub that trying to recover it is not a good idea. Output the number of permutations which could be originally Iahub's important permutation, modulo 1000000007 (109 + 7).

The first line contains integer n (2 ≤ n ≤ 2000). On the second line, there are n integers, representing Iahub's important permutation after Iahubina replaces some values with -1.  It's guaranteed that there are no fixed points in the given permutation. Also, the given sequence contains at least two numbers -1 and each positive number occurs in the sequence at most once. It's guaranteed that there is at least one suitable permutation.

Output a single integer, the number of ways Iahub could recover his permutation, modulo 1000000007 (109 + 7).

NoteFor the first test example there are two permutations with no fixed points are [2, 5, 4, 3, 1] and [5, 1, 4, 3, 2]. Any other permutation would have at least one fixed point.

import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array (accumArray, elems)

-- extended euclidean algorithm: a x  +  b y = gcd(a, b)
gcd' :: Integral a => a -> a -> (a, a)
gcd' a b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop x y x' y' r r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

-- modular multiplicative inverse
-- a * (a `modInv` m) `mod` m = gcd a m `mod` m
modInv :: Integral a => a -> a ->  a
modInv a m = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

solve :: Int -> [Int] -> Int64
solve n a = foldr (\i acc -> (`mod` m).(+ m).(`mod` m) $ (acc + i)) 0 out
    where
    m = 1000000007 :: Int64
    count :: Eq a => a -> [a] -> Int64
    count a = foldr (\i acc -> if i == a then acc + 1 else acc) 0
    -- number of empty slots
    k = count (-1) a :: Int64
    -- number of indices neither mapped nor mapped to
    q = count 0 . elems .accumArray (+) 0 (1, n) . (flip zip) (repeat 1)
        . concatMap (\(i, j) -> if i /= -1 then [i, j] else [])
        $ zip a [1..] :: Int64

    u = reverse $ scanl (\i j -> (i * j) `mod` m) 1 [1..k] :: [Int64]
    v = 1: foldr loop (`seq` []) [1..q] 1 :: [Int64]
        where
        loop i f a = c:f c
            where
            b = a * (q - i + 1)
            c = if b `mod` i /= 0
                then (b `mod` m) * (i `modInv` m) `mod` m
                else (b `div` i) `mod` m

    out = zipWith3 (\a b c -> (`mod` m) . (+ m) . (`mod` m) $ a * b * c) u v $
        cycle [1, -1] :: [Int64]

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve n a

import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array (accumArray, elems)

-- extended euclidean algorithm: a x  +  b y = gcd(a, b)
gcd' :: Integral a => a -> a -> (a, a)
gcd' a b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop x y x' y' r r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

-- modular multiplicative inverse
-- a * (a `modInv` m) `mod` m = gcd a m `mod` m
modInv :: Integral a => a -> a ->  a
modInv a m = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

solve :: Int -> [Int] -> Int64
solve n a = foldr (\i acc -> (`mod` m).(+ m).(`mod` m) $ (acc + i)) 0 out
    where
    m = 1000000007 :: Int64
    count :: Eq a => a -> [a] -> Int64
    count a = foldr (\i acc -> if i == a then acc + 1 else acc) 0
    -- number of empty slots
    k = count (-1) a :: Int64
    -- number of indices neither mapped nor mapped to
    q = count 0 . elems .accumArray (+) 0 (1, n) . (flip zip) (repeat 1)
        . concatMap (\(i, j) -> if i /= -1 then [i,j] else [])
        $ zip a [1..] :: Int64

    u = reverse $ scanl (\i j -> (i * j) `mod` m) 1 [1..k] :: [Int64]
    v = 1: foldr loop (`seq` []) [1..q] 1 :: [Int64]
        where
        loop i f a = (c `mod` m):f c
            where
            b = a * (q - i + 1)
            c = if b `mod` i /= 0
                then (b `mod` m) * (i `modInv` m)
                else b `div` i

    out = zipWith3 (\a b c -> (`mod` m) . (+ m) . (`mod` m) $ a * b * c) u v $
        cycle [1, -1] :: [Int64]

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = parse <$> B.getLine >>= \[n] -> parse <$> B.getLine >>= \a ->
    print $ solve n a


Once Bob took a paper stripe of n squares (the height of the stripe is 1 square). In each square he wrote an integer number, possibly negative. He became interested in how many ways exist to cut this stripe into three pieces so that the sum of numbers from each piece is equal to the sum of numbers from any other piece, and each piece contains positive integer amount of squares. Would you help Bob solve this problem?

The first input line contains integer n (1 ≤ n ≤ 105) — amount of squares in the stripe. The second line contains n space-separated numbers — they are the numbers written in the squares of the stripe. These numbers are integer and do not exceed 10000 in absolute value.

Output the amount of ways to cut the stripe into three non-empty pieces so that the sum of numbers from each piece is equal to the sum of numbers from any other piece. Don't forget that it's allowed to cut the stripe along the squares' borders only.

main = do getLine >> getLine >>= putStrLn . show . gao . map read . words
gao a = sum $ zipWith (*) (0:c) $ init d where
	s = sum a
	b = scanl1 (+) a
	c = scanl1 (+) $ map (\i -> if 3 * i == s then 1 else 0) $ b
	d = map (\i -> if 3 * i == 2 * s then 1 else 0) $ b

{-# LANGUAGE BangPatterns #-}

import Data.Array.IArray
import Data.Array.MArray hiding (unsafeFreeze)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.Array.Unboxed as U
import Data.Array.ST (runSTUArray,STUArray)
import Control.Monad.ST (ST,runST)
import Debug.Trace
import Data.List
import Data.Int

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

readInt :: ByteString -> Int
readInt s =
  case BS.readInt s of
    Nothing     -> error "bad int"
    Just (x,_)  -> x

indexes arr n target inds = runST $ do
  jarr <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  let go a j [] = return j
      go a j (i:is) = let v = a + arr ! i in
                       if v == target then do { writeArray jarr (j+1) i; go v (j+1) is }
                                      else go v j is
  hi <- go 0 0 inds
  jarr' <- unsafeFreeze jarr
  return (jarr', hi)

solve :: Int -> [Int] -> Int64
solve n nums = if total `mod` 3 /= 0 then 0 else count
  where
    total = sum nums
    target = total `div` 3
    arr = listArray (1,n) nums :: U.UArray Int Int

    count =
      let (pre,lasti) = indexes arr n target [1..n]     :: (U.UArray Int Int,Int)
          (suf,lastj) = indexes arr n target [n,n-1..1] :: (U.UArray Int Int, Int)
          go c i j | i > lasti = c
                   | j < 1     = c
                   | (pre ! i)+1 < (suf ! j)  = go (c+fromIntegral j) (i+1) j
                   | otherwise                = go c i (j-1)
      in go 0 1 lastj

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  nums <- BS.getLine --> BS.words --> take n --> map readInt
  print $ solve n nums

{-# LANGUAGE BangPatterns #-}

import Data.Array.IArray
import Data.Array.MArray hiding (unsafeFreeze)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.Array.Unboxed as U
import Data.Array.ST (runSTUArray,STUArray)
import Control.Monad.ST (ST,runST)
import Debug.Trace
import Data.List

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

readInt :: ByteString -> Int
readInt s =
  case BS.readInt s of
    Nothing     -> error "bad int"
    Just (x,_)  -> x

indexes arr n target inds = runST $ do
  jarr <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  let go a j [] = return j
      go a j (i:is) = let v = a + arr ! i in
                       if v == target then do { writeArray jarr (j+1) i; go v (j+1) is }
                                      else go v j is
  hi <- go 0 0 inds
  jarr' <- unsafeFreeze jarr
  return (jarr', hi)

solve :: Int -> [Int] -> Int
solve n nums = if total `mod` 3 /= 0 then 0 else count
  where
    total = sum nums
    target = total `div` 3
    arr = listArray (1,n) nums :: U.UArray Int Int

    count =
      let (pre,lasti) = indexes arr n target [1..n]     :: (U.UArray Int Int,Int)
          (suf,lastj) = indexes arr n target [n,n-1..1] :: (U.UArray Int Int, Int)
          go c i j | i > lasti = c
                   | j < 1     = c
                   | (pre ! i)+1 < (suf ! j)  = go (c+j) (i+1) j
                   | otherwise                = go c i (j-1)
      in go 0 1 lastj

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  nums <- BS.getLine --> BS.words --> take n --> map readInt
  print $ solve n nums


The country Treeland consists of n cities, some pairs of them are connected with unidirectional roads. Overall there are n - 1 roads in the country. We know that if we don't take the direction of the roads into consideration, we can get from any city to any other one.The council of the elders has recently decided to choose the capital of Treeland. Of course it should be a city of this country. The council is supposed to meet in the capital and regularly move from the capital to other cities (at this stage nobody is thinking about getting back to the capital from these cities). For that reason if city a is chosen a capital, then all roads must be oriented so that if we move along them, we can get from city a to any other city. For that some roads may have to be inversed.Help the elders to choose the capital so that they have to inverse the minimum number of roads in the country.

The first input line contains integer n (2 ≤ n ≤ 2·105) — the number of cities in Treeland. Next n - 1 lines contain the descriptions of the roads, one road per line. A road is described by a pair of integers si, ti (1 ≤ si, ti ≤ n; si ≠ ti) — the numbers of cities, connected by that road. The i-th road is oriented from city si to city ti. You can consider cities in Treeland indexed from 1 to n.

In the first line print the minimum number of roads to be inversed if the capital is chosen optimally. In the second line print all possible ways to choose the capital — a sequence of indexes of cities in the increasing order.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao n e = (root + diff, sort $ list [])
  where
    (root, diff, list) = dfs 1 1
    dfs v p = foldl f z $ map (\(i, j) -> (dfs i v, j)) $ filter ((/=p) . fst) $ e!v
        where
          z = (0, 0, (v:))
          f (s, sx, sy) ((t, tx, ty), d) =
            case compare sx tx' of
              LT -> (t', sx, sy)
              EQ -> (t', sx, sy . ty)
              GT -> (t', tx', ty)
            where
              (t', tx') = if d then (s + t, tx + 1) else (s + t + 1, tx - 1)

main = do
  (n:q) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = accumArray (flip (:)) [] (1, n) $ concat [[(i, (j, True)), (j, (i, False))] |
        [i, j] <- map (take 2) $ takeWhile (not . null) $ iterate (drop 2) q]
      (x, y) = gao n e
  putStrLn $ show x
  putStrLn $ unwords $ map show $ y

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao n e = (root + diff, sort list)
  where
    (root, diff, list) = dfs 1 1
    dfs v p = foldl f z $ map (\(i, j) -> (dfs i v, j)) $ filter ((/=p) . fst) $ e!v
        where
          z = (0, 0, [v])
          f (s, sx, sy) ((t, tx, ty), d) =
            case compare sx tx' of
              LT -> (t', sx, sy)
              EQ -> (t', sx, sy ++ ty)
              GT -> (t', tx', ty)
            where
              (t', tx') = if d then (t, tx + 1) else (t + 1, tx - 1)

main = do
  (n:q) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = accumArray (flip (:)) [] (1, n) $ concat [[(i, (j, True)), (j, (i, False))] |
        [i, j] <- map (take 2) $ takeWhile (not . null) $ iterate (drop 2) q]
      (x, y) = gao n e
  putStrLn $ show x
  putStrLn $ unwords $ map show $ y