Polycarp likes to play with numbers. He takes some integer number $$$x$$$, writes it down on the board, and then performs with it $$$n - 1$$$ operations of the two kinds:   divide the number $$$x$$$ by $$$3$$$ ($$$x$$$ must be divisible by $$$3$$$);  multiply the number $$$x$$$ by $$$2$$$. After each operation, Polycarp writes down the result on the board and replaces $$$x$$$ by the result. So there will be $$$n$$$ numbers on the board after all.You are given a sequence of length $$$n$$$ — the numbers that Polycarp wrote down. This sequence is given in arbitrary order, i.e. the order of the sequence can mismatch the order of the numbers written on the board.Your problem is to rearrange (reorder) elements of this sequence in such a way that it can match possible Polycarp's game in the order of the numbers written on the board. I.e. each next number will be exactly two times of the previous number or exactly one third of previous number.It is guaranteed that the answer exists.

The first line of the input contatins an integer number $$$n$$$ ($$$2 \le n \le 100$$$) — the number of the elements in the sequence. The second line of the input contains $$$n$$$ integer numbers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 3 \cdot 10^{18}$$$) — rearranged (reordered) sequence that Polycarp can wrote down on the board.

Print $$$n$$$ integer numbers — rearranged (reordered) input sequence that can be the sequence that Polycarp could write down on the board. It is guaranteed that the answer exists.

NoteIn the first example the given sequence can be rearranged in the following way: $$$[9, 3, 6, 12, 4, 8]$$$. It can match possible Polycarp's game which started with $$$x = 9$$$.

module Main where

import Data.Int

takeElements :: [a] -> [(a, [a])]
takeElements [] = []
takeElements (x:xs) = (x, xs) : [(y, x:ys) | (y, ys) <- takeElements xs]

solve :: [Int64] -> [[Int64]]
solve = go []
  where
    go :: [Int64] -> [Int64] -> [[Int64]]
    go [] zs = do
      (y, ys) <- takeElements zs
      go [y] ys
    go ls [] = [reverse ls]
    go ls@(l:_) zs = do
      (i, is) <- takeElements zs
      if i == (l * 2) || (l `mod` 3 == 0 && i * 3 == l) then go (i:ls) is
      else []

main :: IO ()
main = do
  _ <- getLine
  xs <- fmap (map read . words) getLine
  let result = head $ solve xs
  putStrLn $ unwords (map show result)

import Data.List
import Data.Function

main = do
  n <-readLn
  as <- fmap (map read . words) getLine
  putStrLn $ unwords $ map show $ solve n as

solve :: Int -> [Integer] -> [Integer]
solve n as =
  map fst $ sortBy(compare`on`f) $ map factorize as
  where
    f (k,(c2,c3)) = (-c3,c2)

factorize :: Integer -> (Integer, (Integer,Integer))
factorize n =
  (n,(c2,c3))
  where
    (c2,n') = go 0 2 n
    (c3,_ ) = go 0 3 n'

    go c p k = let (q,r) = k`divMod`p
               in if r==0 then go (c+1) p q else (c,k)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    n <- readLn
    xs <- unfoldr (B.readInteger.B.dropWhile isSpace) <$> B.getLine
    putStrLn.unwords.map show $ solve n xs

solve :: Int -> [Integer] -> [Integer]
solve n xs = head [hist | x<-xs, Just hist <- pure $ dfs x [x] (S.delete x $ S.fromList xs)]
  where
    dfs _ hist unused | S.null unused = Just $ reverse hist
    dfs cur hist unused = case quotRem cur 3 of
        (q, 0) | !c2 <- 2 * cur, S.member q unused && S.member c2 unused ->
         dfs q (q:hist) (S.delete q unused)
            <|> dfs c2 (c2:hist) (S.delete c2 unused)
               | S.member q unused -> dfs q (q:hist) (S.delete q unused)
        (_, _) | !c2 <- 2 * cur, S.member c2 unused -> dfs c2 (c2:hist) (S.delete c2 unused)
        _ -> Nothing

module Main (main) where

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

type MapType = Map.Map Integer Integer

readIntegers :: String -> [Integer]
readIntegers = map read . words

solve :: [Integer] -> [Integer]
solve lst = reverse ans where
    insert' :: [Integer] -> MapType -> MapType
    insert' [] mp = mp
    insert' (x:xs) mp = insert' xs (Map.insertWith (+) x 1 mp)
    mmap = insert' lst (Map.fromList [])
    findFirst :: [Integer] -> MapType -> Integer
    findFirst (x:xs) mp = res where
        fit = ((mod x 2 > 0) || (Map.lookup (div x 2) mp) == Nothing) && ((Map.lookup (x * 3) mp) == Nothing)
        res = if fit then x else findFirst xs mp
    first = findFirst lst mmap
    solve' :: MapType -> Int -> Integer -> [Integer] -> [Integer]
    solve' mp 0 x res = res
    solve' mp cnt x res = solve' mp' (cnt-1) next (x:res) where
        t = Map.lookup (x*2) mp
        next = if t /= Nothing && t > (Just 0) then x * 2 else (div x 3)
        mp' = Map.insertWith (-) 1 next mp
    ans = solve' mmap (length lst) first []

main :: IO ()
main = putStrLn . toStr. solve . readIntegers  =<< (getLine >> getLine)
    where toStr = unwords . map show


Alice and Bob want to play a game. They have $$$n$$$ colored paper strips; the $$$i$$$-th strip is divided into $$$a_i$$$ cells numbered from $$$1$$$ to $$$a_i$$$. Each cell can have one of $$$3$$$ colors.In the beginning of the game, Alice and Bob put $$$n$$$ chips, the $$$i$$$-th chip is put in the $$$a_i$$$-th cell of the $$$i$$$-th strip. Then they take turns, Alice is first. Each player during their turn has to choose one chip and move it $$$1$$$, $$$2$$$ or $$$3$$$ cells backwards (i. e. if the current cell is $$$x$$$, then the chip can be moved to the cell $$$x - 1$$$, $$$x - 2$$$ or $$$x - 3$$$). There are two restrictions: the chip cannot leave the borders of the strip (for example, if the current cell is $$$3$$$, then you can't move the chip $$$3$$$ cells backwards); and some moves may be prohibited because of color of the current cell (a matrix $$$f$$$ with size $$$3 \times 3$$$ is given, where $$$f_{i, j} = 1$$$ if it is possible to move the chip $$$j$$$ cells backwards from the cell which has color $$$i$$$, or $$$f_{i, j} = 0$$$ if such move is prohibited). The player who cannot make a move loses the game.Initially some cells may be uncolored. Bob can color all uncolored cells as he wants (but he cannot leave any cell uncolored). Let's call a coloring good if Bob can win the game no matter how Alice acts, if the cells are colored according to this coloring. Two colorings are different if at least one cell is colored in different colors in these two colorings.Bob wants you to calculate the number of good colorings. Can you do it for him?Since the answer can be really large, you have to print it modulo $$$998244353$$$.

The first line contains one integer $$$n$$$ — the number of paper strips ($$$1 \le n \le 1000$$$). The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the number of cells in the $$$i$$$-th strip. The third line contains one integer $$$m$$$ ($$$1 \le m \le 1000$$$) — the number of cells that are already colored. Then $$$m$$$ lines follow, each describing an already colored cell. The $$$i$$$-th of these lines contains three integers $$$x_i$$$, $$$y_i$$$ and $$$c_i$$$ ($$$1 \le x_i \le n$$$, $$$1 \le y_i \le a_{x_i}$$$, $$$1 \le c_i \le 3$$$) denoting that the cell $$$y_i$$$ in the strip $$$x_i$$$ has color $$$c_i$$$. It is guaranteed that if $$$i \ne j$$$, then either $$$x_i \ne x_j$$$ or $$$y_i \ne y_j$$$ (or both). Then $$$3$$$ lines follow, $$$i$$$-th line containing $$$3$$$ numbers $$$f_{i, 1}$$$, $$$f_{i, 2}$$$, $$$f_{i, 3}$$$ ($$$0 \le f_{i, j} \le 1$$$). If $$$f_{i, j} = 1$$$, then it is possible to move the chip $$$j$$$ cells backwards from the cell having color $$$i$$$; if $$$f_{i, j} = 0$$$, then such move is impossible.

Print one integer: the number of good colorings, taken modulo $$$998244353$$$.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad (replicateM)
import Control.Monad.ST (ST)
import Data.Array.IArray ((!), accumArray, array, bounds)
import Data.Array.MArray.Safe (newArray, newArray_, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.&.), (.|.), shiftL, shiftR, xor)
import qualified Data.ByteString.Char8 as BS
  ( dropWhile
  , getContents
  , getLine
  , readInt
  )
import Data.Char (isSpace)
import Data.Int (Int64)
import Data.List (groupBy, sort)
import Data.Sequence
  ( Seq
  , Seq(Empty)
  , Seq((:<|))
  , Seq((:|>))
  , adjust'
  , fromList
  , index
  , iterateN
  )
import qualified Data.Sequence as S (drop, replicate, update)

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

newtype Mat a =
  Mat (UArray (Int, Int) a)

type MMat = Mat Int64

mm = 998244353 :: Int64

reduce mm a b
  | s < mm = s
  | otherwise = s - mm
  where
    s = a + b

{-# INLINE reduce #-}
matMul :: MMat -> MMat -> MMat
matMul (Mat a) (Mat b)
  | t /= p || t' /= p' = undefined
  | otherwise = Mat c
  where
    ((s, t), (s', t')) = bounds a
    ((p, q), (p', q')) = bounds b
    mm2 = mm * mm
    c =
      runSTUArray $ do
        mem <- newArray ((s, q), (s', q')) 0
        sequence_
          [ do s <- readArray mem (i, j)
               let x = a ! (i, k)
                   y = b ! (k, j)
               writeArray mem (i, j) (reduce mm2 s (x * y))
          | i <- [s .. s']
          , j <- [q .. q']
          , k <- [t .. t']
          ]
        sequence_
          [ readArray mem (i, j) >>= writeArray mem (i, j) . (`mod` mm)
          | i <- [s .. s']
          , j <- [q .. q']
          ]
        return mem

matAdd :: MMat -> MMat -> MMat
matAdd (Mat a) (Mat b)
  | s /= p || s' /= p' || t /= q || t' /= q' = undefined
  | otherwise = Mat c
  where
    ((s, t), (s', t')) = bounds a
    ((p, q), (p', q')) = bounds b
    c =
      runSTUArray $ do
        mem <- newArray_ ((s, t), (s', t'))
        sequence_
          [ let x = a ! (i, j)
                y = b ! (i, j)
             in writeArray mem (i, j) (reduce mm x y)
          | i <- [s .. s']
          , j <- [t .. t']
          ]
        return mem

matPow :: Seq MMat -> Int -> MMat -> MMat
matPow _ 0 p = p
matPow (m :<| ms) n p
  | n .&. 1 == 1 = matPow ms (n `shiftR` 1) (m `matMul` p)
  | otherwise = matPow ms (n `shiftR` 1) p

minmex :: [Int] -> Int
minmex s = head . dropWhile (`elem` s) $ [0 ..]

initial :: [Int] -> MMat
initial move =
  Mat . accumArray (+) 0 ((0, 0), (63, 63)) $ do
    x1 <- [0 .. 3]
    x2 <- [0 .. 3]
    x3 <- [0 .. 3]
    let hash x1 x2 x3 = x1 `shiftL` 4 .|. x2 `shiftL` 2 .|. x3
        n = minmex . fmap snd . filter ((== 1) . fst) . zip move $ [x1, x2, x3]
    return ((hash n x1 x2, hash x1 x2 x3), 1)

main = do
  [n] <- fmap parseInts BS.getLine
  a <- fmap parseInts BS.getLine
  [m] <- fmap parseInts BS.getLine
  color <- replicateM m (fmap parseInts BS.getLine)
  move <- replicateM 3 (fmap parseInts BS.getLine)
  let tc = fromList (fmap (initial . (move !!)) [0 .. 2])
      t = foldl1 matAdd tc
      pt = iterateN 30 (\a -> matMul a a) t
      color' =
        groupBy (\a b -> head a == head b) . sort $
        color ++ zipWith (\ai i -> [i, ai + 1, 0]) a [1 ..]
      step (n, vec) [i, ai, c]
        | c == 0 = (-1, matPow pt (ai - n - 1) vec)
        | otherwise = (ai, index tc (c - 1) `matMul` matPow pt (ai - n - 1) vec)
      sgInit = S.replicate 4 0
      sgvs = do
        cs <- color'
        let start = (0, Mat (accumArray (+) 0 ((0, 0), (63, 0)) [((63, 0), 1)]))
            (_, Mat sg64) = foldl step start cs
        return
          (foldl
             (\sg i ->
                adjust' (\x -> reduce mm x (sg64 ! (i, 0))) (i `shiftR` 4) sg)
             sgInit
             [0 .. 63])
      ret = foldl sgxor (S.update 0 1 sgInit) sgvs
      sgxor p q =
        foldr
          ($)
          sgInit
          [ adjust' (reduce mm (index p i * index q j `mod` mm)) (i `xor` j)
          | i <- [0 .. 3]
          , j <- [0 .. 3]
          ]
  print (index ret 0)


You are given $$$n$$$ words, each of which consists of lowercase alphabet letters. Each word contains at least one vowel. You are going to choose some of the given words and make as many beautiful lyrics as possible.Each lyric consists of two lines. Each line consists of two words separated by whitespace. A lyric is beautiful if and only if it satisfies all conditions below.   The number of vowels in the first word of the first line is the same as the number of vowels in the first word of the second line.  The number of vowels in the second word of the first line is the same as the number of vowels in the second word of the second line.  The last vowel of the first line is the same as the last vowel of the second line. Note that there may be consonants after the vowel. Also, letters "a", "e", "o", "i", and "u" are vowels. Note that "y" is never vowel.For example of a beautiful lyric,  "hello hellooowww" "whatsup yowowowow"  is a beautiful lyric because there are two vowels each in "hello" and "whatsup", four vowels each in "hellooowww" and "yowowowow" (keep in mind that "y" is not a vowel), and the last vowel of each line is "o".For example of a not beautiful lyric,  "hey man""iam mcdic"  is not a beautiful lyric because "hey" and "iam" don't have same number of vowels and the last vowels of two lines are different ("a" in the first and "i" in the second).How many beautiful lyrics can you write from given words? Note that you cannot use a word more times than it is given to you. For example, if a word is given three times, you can use it at most three times.

The first line contains single integer $$$n$$$ ($$$1 \le n \le 10^{5}$$$) — the number of words. The $$$i$$$-th of the next $$$n$$$ lines contains string $$$s_{i}$$$ consisting lowercase alphabet letters — the $$$i$$$-th word. It is guaranteed that the sum of the total word length is equal or less than $$$10^{6}$$$. Each word contains at least one vowel.

In the first line, print $$$m$$$ — the number of maximum possible beautiful lyrics. In next $$$2m$$$ lines, print $$$m$$$ beautiful lyrics (two lines per lyric). If there are multiple answers, print any.

14
wow
this
is
the
first
mcdics
codeforces
round
hooray
i
am
proud
about
that

7
arsijo
suggested
the
idea
for
this
problem

3
about proud
hooray round
wow first
this is
i that
mcdics am

NoteIn the first example, those beautiful lyrics are one of the possible answers. Let's look at the first lyric on the sample output of the first example. "about proud hooray round" forms a beautiful lyric because "about" and "hooray" have same number of vowels, "proud" and "round" have same number of vowels, and both lines have same last vowel. On the other hand, you cannot form any beautiful lyric with the word "codeforces".In the second example, you cannot form any beautiful lyric from given words.In the third example, you can use the word "same" up to three times.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word
#ifdef DEBUG
import           Debug.Trace
#endif
import Foreign
import qualified  System.IO                 as IO

main :: IO ()
main = do
  !n <- readLn :: IO Int
  bss <- C.lines <$> C.getContents
  let (m, b) = solve n bss
  print m
  B.hPutBuilder IO.stdout b

solve :: Int -> [C.ByteString] -> (Int, B.Builder)
solve n bss = (,) m $ construct m
  where
    dict :: A.Array Int C.ByteString
    !dict = A.listArray (0, n-1) bss

    encoded = zipWith encode [0..] bss
    (vow0, vows) = L.partition ((==0).fst) encoded

    sorted :: [(Int, Int)]
    !sorted = L.sort vows

    !m = upperBound 0 (div n 4) ok

    ok :: Int -> Bool
    ok k = go k [] $ map fst sorted
      where
        go 0 stock xs
          = (== k) . length . take k
          . pairs (==)
          . map (flip quot 10) $ map fst vow0 ++ reverse stock ++ xs
        go !acc !stock (x:y:xs)
          | x == y = go (acc - 1) stock xs
          | otherwise = go acc (x:stock) (y:xs)
        go _ _ _ = False

    construct :: Int -> B.Builder
    construct k = go2 k [] [] sorted
      where
        go2 0 stock ws xs = mconcat . zipWith merge ws
          . go1 k $ vow0 ++ reverse stock ++ xs
        go2 acc stock ws ((x,i):(y,j):xs)
          | x == y = go2 (acc-1) stock ((i, j):ws) xs
          | otherwise = go2 acc ((x,i):stock) ws ((y,j):xs)
        go1 0 _ = []
        go1 !acc ((x, i):(y, j):xs)
          | quot x 10 == quot y 10 = (i, j) : go1 (acc - 1) xs
          | otherwise = go1 acc ((y, j):xs)

        merge (x2, y2) (x1, y1)
          = mconcat
            [ B.byteString bsx1
            , B.char7 ' '
            , B.byteString bsx2
            , B.char7 '\n'
            , B.byteString bsy1
            , B.char7 ' '
            , B.byteString bsy2
            , B.char7 '\n'
            ]
          where
            bsx1 = dict A.! x1
            bsx2 = dict A.! x2
            bsy1 = dict A.! y1
            bsy2 = dict A.! y2

pairs :: (a -> a -> Bool) -> [a] -> [(a, a)]
pairs eq (x:y:xs)
  | eq x y = (x, y) : pairs eq xs
  | otherwise = pairs eq (y:xs)
pairs eq _ = []

isVowel :: Char -> Bool
isVowel c = elem c "aeiou"

encode :: Int -> C.ByteString -> (Int, Int)
encode i bs
    | len == 0 = (0, i)
    | otherwise = case C.last vowels of
      'a' -> (10 * len + 1, i)
      'e' -> (10 * len + 2, i)
      'i' -> (10 * len + 3, i)
      'o' -> (10 * len + 4, i)
      'u' -> (10 * len + 5, i)
  where
    vowels = C.filter isVowel bs
    len = C.length vowels

lowerBound :: (Integral i) => i -> i -> (i -> Bool) -> i
lowerBound low high p = go low high
  where
    go !low !high
        | high <= low = high
        | p mid       = go low       mid
        | otherwise   = go (mid + 1) high
      where
        h = toInteger high
        l = toInteger low
        mid = fromIntegral $ l + div (h - l) 2
{-# INLINE lowerBound #-}

upperBound :: (Integral i) => i -> i -> (i -> Bool) -> i
upperBound low high p
    | p high = high
    | otherwise = lowerBound low high (not.p) - 1
{-# INLINE upperBound #-}


In the rush of modern life, people often forget how beautiful the world is. The time to enjoy those around them is so little that some even stand in queues to several rooms at the same time in the clinic, running from one queue to another.(Cultural note: standing in huge and disorganized queues for hours is a native tradition in Russia, dating back to the Soviet period. Queues can resemble crowds rather than lines. Not to get lost in such a queue, a person should follow a strict survival technique: you approach the queue and ask who the last person is, somebody answers and you join the crowd. Now you're the last person in the queue till somebody else shows up. You keep an eye on the one who was last before you as he is your only chance to get to your destination) I'm sure many people have had the problem when a stranger asks who the last person in the queue is and even dares to hint that he will be the last in the queue and then bolts away to some unknown destination. These are the representatives of the modern world, in which the ratio of lack of time is so great that they do not even watch foreign top-rated TV series. Such people often create problems in queues, because the newcomer does not see the last person in the queue and takes a place after the "virtual" link in this chain, wondering where this legendary figure has left.The Smart Beaver has been ill and he's made an appointment with a therapist. The doctor told the Beaver the sad news in a nutshell: it is necessary to do an electrocardiogram. The next day the Smart Beaver got up early, put on the famous TV series on download (three hours till the download's complete), clenched his teeth and bravely went to join a queue to the electrocardiogram room, which is notorious for the biggest queues at the clinic.Having stood for about three hours in the queue, the Smart Beaver realized that many beavers had not seen who was supposed to stand in the queue before them and there was a huge mess. He came up to each beaver in the ECG room queue and asked who should be in front of him in the queue. If the beaver did not know his correct position in the queue, then it might be his turn to go get an ECG, or maybe he should wait for a long, long time...As you've guessed, the Smart Beaver was in a hurry home, so he gave you all the necessary information for you to help him to determine what his number in the queue can be.

The first line contains two integers n (1 ≤ n ≤ 103) and x (1 ≤ x ≤ n) — the number of beavers that stand in the queue and the Smart Beaver's number, correspondingly. All willing to get to the doctor are numbered from 1 to n. The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ n) — the number of the beaver followed by the i-th beaver. If ai = 0, then the i-th beaver doesn't know who is should be in front of him. It is guaranteed that values ai are correct. That is there is no cycles in the dependencies. And any beaver is followed by at most one beaver in the queue. The input limits for scoring 30 points are (subproblem B1):    It is guaranteed that the number of zero elements ai doesn't exceed 20.  The input limits for scoring 100 points are (subproblems B1+B2):    The number of zero elements ai is arbitrary.

Print all possible positions of the Smart Beaver in the line in the increasing order.

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Tuple
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.Either
import Data.Ix
import Debug.Trace

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

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  putStr.unlines.map show.sort $ solve n x xs

solve :: Int -> Int -> [Int] -> [Int]
solve n x xs = map (xi+) $ filter (unsafeAt dp) [0..n-xi]
   where
     gr = mkGraph n edges
     edges = zip xs [1..]
     (ls,[xi]) = partitionEithers.sort.map (elemSmart x.childs gr) $ roots n edges
     !dp = gen n ls

gen :: Int -> [Int] -> UArray Int Bool
gen n sorted = runSTUArray $ do
  dp <- newArray (0,n) False :: ST s (STUArray s Int Bool)
  unsafeWrite dp 0 True
  forM sorted $ \x-> do
    forM [n-x,n-x-1..0] $ \i-> do
      dpi <- unsafeRead dp i
      when dpi $ do
        unsafeWrite dp (i+x) True
  return dp

elemSmart :: Vertex -> [Vertex] -> Either Int Int
elemSmart x vs
  | Just i <- elemIndex x vs = Right $! i+1
  | otherwise = Left $! length vs

type Graph = UArray Vertex Vertex
type Vertex = Int
type Edge = (Vertex,Vertex)

mkGraph :: Int -> [Edge] -> Graph
mkGraph n es = runSTUArray $ do
  gr <- newArray (0,n) 0  :: ST s (STUArray s Vertex Vertex)
  forM es $ \ (from,to) -> do
    unsafeWrite gr from to
  return gr

mkRevGraph :: Int -> [Edge] -> Graph
mkRevGraph n es = runSTUArray $ do
  gr <- newArray (0,n) 0  :: ST s (STUArray s Vertex Vertex)
  forM es $ \ (to,from) -> do
    unsafeWrite gr from to
  return gr

roots :: Int -> [Edge] -> [Vertex]
roots n es = filter ((0==).unsafeAt revgr) [1..n]
   where
     !revgr = mkRevGraph n es

childs :: Graph -> Vertex -> [Vertex]
childs gr v = takeWhile (0<) $ iterate (unsafeAt gr) v


Petya has got 2n cards, each card contains some integer. The numbers on the cards can be the same. Let's index all cards by consecutive integers from 1 to 2n. We'll denote the number that is written on a card with number i, as ai. In order to play one entertaining game with his friends, Petya needs to split the cards into pairs so that each pair had equal numbers on the cards. Help Petya do that.

The first line contains integer n (1 ≤ n ≤ 3·105). The second line contains the sequence of 2n positive integers a1, a2, ..., a2n (1 ≤ ai ≤ 5000) — the numbers that are written on the cards. The numbers on the line are separated by single spaces.

If it is impossible to divide the cards into pairs so that cards in each pair had the same numbers, print on a single line integer -1. But if the required partition exists, then print n pairs of integers, a pair per line — the indices of the cards that form the pairs. Separate the numbers on the lines by spaces. You can print the pairs and the numbers in the pairs in any order. If there are multiple solutions, print any of them.

import Control.Monad (liftM, replicateM)
import Data.Array
import Data.Array.ST
import Data.Char (ord)
import Data.List (intercalate)
import Prelude hiding (reads)

inputFile  =  "input.txt"
outputFile  =  "output.txt"

reads :: String ->  [Int]
reads  =  map read . words
  where
    read s  =  read' 0 s
    read' a ""  =  a
    read' a (c:s)  =  read' (10*a + ord c - ord '0') s

prints :: Show a => [a] -> String
prints  =  intercalate " " . map show

showAns :: [(Int, Int)] -> String
showAns []  =  "-1"
showAns xs  =  unlines $ map showPair xs
  where
    showPair (x, y)  =  concat [show x, " ", show y]

solve :: [Int]  ->  [(Int, Int)]
solve as
    | existSolve  =  concatMap (getPairs . (array !)) [1..size]
    | otherwise  =  []
  where
    size  =  5000
    array :: Array Int [Int]
    array  =  runSTArray $ do
        array  <-  newArray (1, size) []
        mapM_ (update array) $ zip [1..] as
        return array
      where
        update array (i, a)  =  do
            is  <-  readArray array a
            writeArray array a (i:is)
    existSolve  =  all (even . length . (array !)) [1..size]
    getPairs []  =  []
    getPairs (a:b:as)  =  (a,b) : getPairs as

main :: IO ()
main  =  do
    input  <-  readFile inputFile
    let as  =  tail $ reads input
    let output  =  showAns $ solve as
    writeFile outputFile output

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import System.IO
import Data.Array.Base
import Data.Array.IO (IOUArray,IOArray)
import qualified Data.ByteString.Char8 as B

readInt bs = case B.readInt bs of Just (n,_) -> n
getIntLn  handle = fmap (map readInt.B.words) $ B.hGetLine     handle
getIntAll handle = fmap (map readInt.B.words) $ B.hGetContents handle

main = do
  hin  <- openFile "input.txt"  ReadMode
  hout <- openFile "output.txt" WriteMode

  (n:xs) <- getIntAll hin

  cnt <- newArray (0,5000) 0  :: IO (IOUArray Int Int)
  ans <- newArray (0,5000) [] :: IO (IOArray Int [Int])

  forM_ (zip[1..]xs) $ \(i,x) -> do
    unsafeRead cnt x >>= unsafeWrite cnt x.(1+)
    unsafeRead ans x >>= unsafeWrite ans x.(i:)
  isValid <- all even <$> mapM (unsafeRead cnt) [1..5000]

  if isValid
     then hPutStr hout.parse.concat =<< mapM (unsafeRead ans) [1..5000]
     else hPrint hout $ -1

  hClose hin
  hClose hout

parse :: [Int] -> String
parse (i:j:rest) = shows i" " ++ shows j "\n" ++ parse rest
parse _ = ""

import Control.Applicative
import Data.List
import Data.Function
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import qualified Data.IntMap.Strict as I

myprint::[String]->[Int]->[String]
myprint  x [] =  x
myprint q (x:y:z) =  myprint ( ( show x ++ " " ++ show y++   "\n"):q) z

main=do
	n<-B.readFile "input.txt"
	let s = tail $ map (fst.fromJust.B.readInt)  $ B.words  n:: [Int]
	let t= foldl (\acc z->I.insertWith (++) (fst z ) [snd z] acc) I.empty $ zip s [1..]::I.IntMap [Int]
	let t1= I.elems t
	writeFile "output.txt"  $if any (odd) (map length t1) then "-1\n" else concat $ reverse $ myprint [""] $ concat t1

import Control.Monad (liftM)
import Data.Array
import System.IO (IOMode(..), openFile, hPrint, hPutStrLn)

solve :: Int -> [Int] -> Maybe [(Int, Int)]
solve n xs
  | length xs' == n  =  Just xs'
  | otherwise  =  Nothing
  where
    xs'  =  solve' e $ zip [1..] xs
    e    =  listArray (1,5000) [0,0..]
    solve' _ []  =  []
    solve' a ((n, x) : xs)
      | a ! x > 0  =  (a ! x, n) : solve' a' xs
      | otherwise  =  solve' a'' xs
      where
        a'   =  a // [(x, 0)]
        a''  =  a // [(x, n)]

printAns Nothing  =  print (-1)
printAns (Just xs)  =  do
    hOutput  <-  openFile "output.txt" WriteMode
    mapM_ (print' hOutput) xs
  where
    print' hOutput (a, b)  =  hPutStrLn hOutput $ concat [show a, " ", show b]

main :: IO ()
main  =  do
    lines'  <-  liftM lines $ readFile "input.txt"
    let n   =  read $ lines' !! 0
    let xs  =  map read $ words $ lines' !! 1
--    n   <-  readLn
--    xs  <-  liftM (map read . words) getLine
    printAns $ solve n xs

import Control.Monad (liftM)
import Data.Array
import System.IO (IOMode(..), hClose, hPrint, hPutStrLn, openFile)

solve :: Int -> [Int] -> Maybe [(Int, Int)]
solve n xs
  | length xs' == n  =  Just xs'
  | otherwise  =  Nothing
  where
    xs'  =  solve' e $ zip [1..] xs
    e    =  listArray (1,5000) [0,0..]
    solve' _ []  =  []
    solve' a ((n, x) : xs)
      | a ! x > 0  =  (a ! x, n) : solve' a' xs
      | otherwise  =  solve' a'' xs
      where
        a'   =  a // [(x, 0)]
        a''  =  a // [(x, n)]

printAns Nothing  =  print (-1)
printAns (Just xs)  =  do
    hOutput  <-  openFile "output.txt" WriteMode
    mapM_ (print' hOutput) xs
    hClose hOutput
  where
    print' hOutput (a, b)  =  hPutStrLn hOutput $ concat [show a, " ", show b]

main :: IO ()
main  =  do
    lines'  <-  liftM lines $ readFile "input.txt"
    let n   =  read $ lines' !! 0
    let xs  =  map read $ words $ lines' !! 1
--    n   <-  readLn
--    xs  <-  liftM (map read . words) getLine
    printAns $ solve n xs


You are given n points with integer coordinates on the plane. Points are given in a way such that there is no triangle, formed by any three of these n points, which area exceeds S.Alyona tried to construct a triangle with integer coordinates, which contains all n points and which area doesn't exceed 4S, but, by obvious reason, had no success in that. Please help Alyona construct such triangle. Please note that vertices of resulting triangle are not necessarily chosen from n given points.

In the first line of the input two integers n and S (3 ≤ n ≤ 5000, 1 ≤ S ≤ 1018) are given — the number of points given and the upper bound value of any triangle's area, formed by any three of given n points. The next n lines describes given points: ith of them consists of two integers xi and yi ( - 108 ≤ xi, yi ≤ 108) — coordinates of ith point. It is guaranteed that there is at least one triple of points not lying on the same line.

Print the coordinates of three points — vertices of a triangle which contains all n points and which area doesn't exceed 4S. Coordinates of every triangle's vertex should be printed on a separate line, every coordinate pair should be separated by a single space. Coordinates should be an integers not exceeding 109 by absolute value. It is guaranteed that there is at least one desired triangle. If there is more than one answer, print any of them.

readPt s = let (x:y:_) = map read $ words s in (x, y)

main = do
    n <- fmap (read . head . words) getLine
    pts <- mapM (\_ -> fmap readPt getLine) [1..n]
    let ((x1,y1),(x2,y2),(x3,y3)) = solve pts (pts !! 0, pts !! 1, pts !! 2)
    putStrLn $ show (x1+x2-x3) ++ " " ++ show (y1+y2-y3)
    putStrLn $ show (x1+x3-x2) ++ " " ++ show (y1+y3-y2)
    putStrLn $ show (x2+x3-x1) ++ " " ++ show (y2+y3-y1)

sq ((x1, y1),(x2, y2),(x3, y3)) = abs $ (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)

solve pts t = if sq t < sq new_t then solve pts new_t else t
  where fst = sq t
        new_t = foldl best3 (foldl best2 (foldl best1 t pts) pts) pts
        --new_t = foldl (\t f -> foldl f t pts) t [best1, best2, best3]

best a b = if (sq a) > (sq b) then a else b
best1 (a1, a2, a3) p = best (a1, a2, p) (a1, a2, a3)
best2 (a1, a2, a3) p = best (a1, p, a3) (a1, a2, a3)
best3 (a1, a2, a3) p = best (p, a2, a3) (a1, a2, a3)


Petya and Vasya are inventing a new game that requires a rectangular board and one chess piece. At the beginning of the game the piece stands in the upper-left corner of the board. Two players move the piece in turns. Each turn the chess piece can be moved either one square to the right or one square down or jump k squares diagonally down and to the right. The player who can’t move the piece loses.   The guys haven’t yet thought what to call the game or the best size of the board for it. Your task is to write a program that can determine the outcome of the game depending on the board size.

The first input line contains two integers t and k (1 ≤ t ≤ 20, 1 ≤ k ≤ 109). Each of the following t lines contains two numbers n, m — the board’s length and width (1 ≤ n, m ≤ 109).

Output t lines that can determine the outcomes of the game on every board. Write «+» if the first player is a winner, and «-» otherwise.

import Monad (liftM)

parse :: Read a => String -> (a, a)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

f i j k
  | k == 1  =  if i `mod` 2 == 1 && j `mod` 2 == 1 then 0 else 1
  | i > j  =  f j i k
  | i `mod` (k+1) == 0  =  2 + (i+j) `mod` 2
  | otherwise  =  (i + j + min i' j') `mod` 2
  where
    (i', j')  =  (i `div` (k+1), j `div` (k+1))

solve :: Int -> (Int, Int) -> String
solve k (n, m)  =  if f n m k == 0 then "-" else "+"

main :: IO ()
main  =  do
    ls  <-  liftM lines $ readFile "input.txt"
    let (t, k)  =  parse . head $ ls
    let xs  =  map parse . take t . tail $ ls
    writeFile "output.txt" $ unlines $ map (solve k) xs

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f input = output where
  output = unlines $ a q
  [t,k]:q = map (map (read::String->Integer)) $ map words $ lines input
  a [] = []
  a ([n,m]:xs) = (answer n m):a xs
  answer n m
    | mod x (k+1) == 0 = "+"
    | mod (div x (k+1)) 2 == 0 || k==1 = if y then "-" else "+"
    | otherwise                        = if y then "+" else "-"
   where
     x = min n m
     y = mod (n+m) 2 == 0

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f input = output where
  output = unlines $ a q
  [t,k]:q = map (map (read::String->Integer)) $ map words $ lines input
  a [] = []
  a ([n,m]:xs) = (answer n m):a xs
  answer n m
    | mod x (k+1) == 0 = "+"
    | mod (div x (k+1)) 2 == 0 || k==0 = if y then "-" else "+"
    | otherwise                        = if y then "+" else "-"
   where
     x = min n m
     y = mod (n+m) 2 == 0

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f input = output where
  output = unlines $ a q
  [t,k]:q = map (map (read::String->Int)) $ map words $ lines input
  a [] = []
  a ([n,m]:xs) = (answer n m):a xs
  answer n m
    | mod x (k+1) == 0 = "+"
    | mod (div x (k+1)) 2 == 0 = if y then "-" else "+"
    | otherwise                = if y then "+" else "-"
   where
     x = min n m
     y = mod (n+m) 2 == 0

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f input = output where
  output = unlines $ a q
  [t,k]:q = map (map (read::String->Integer)) $ map words $ lines input
  a [] = []
  a ([n,m]:xs) = (answer n m):a xs
  answer n m
    | mod x (k+1) == 0 = "+"
    | mod (div x (k+1)) 2 == 0 = if y then "-" else "+"
    | otherwise                = if y then "+" else "-"
   where
     x = min n m
     y = mod (n+m) 2 == 0


Monocarp had a tree which consisted of $$$n$$$ vertices and was rooted at vertex $$$1$$$. He decided to study BFS (Breadth-first search), so he ran BFS on his tree, starting from the root. BFS can be described by the following pseudocode:a = [] # the order in which vertices were processedq = Queue()q.put(1) # place the root at the end of the queuewhile not q.empty():    k = q.pop() # retrieve the first vertex from the queue    a.append(k) # append k to the end of the sequence in which vertices were visited    for y in g[k]: # g[k] is the list of all children of vertex k, sorted in ascending order        q.put(y)Monocarp was fascinated by BFS so much that, in the end, he lost his tree. Fortunately, he still has a sequence of vertices, in which order vertices were visited by the BFS algorithm (the array a from the pseudocode). Monocarp knows that each vertex was visited exactly once (since they were put and taken from the queue exactly once). Also, he knows that all children of each vertex were viewed in ascending order.Monocarp knows that there are many trees (in the general case) with the same visiting order $$$a$$$, so he doesn't hope to restore his tree. Monocarp is okay with any tree that has minimum height.The height of a tree is the maximum depth of the tree's vertices, and the depth of a vertex is the number of edges in the path from the root to it. For example, the depth of vertex $$$1$$$ is $$$0$$$, since it's the root, and the depth of all root's children are $$$1$$$.Help Monocarp to find any tree with given visiting order $$$a$$$ and minimum height.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of vertices in the tree. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$; $$$a_i \neq a_j$$$; $$$a_1 = 1$$$) — the order in which the vertices were visited by the BFS algorithm. It's guaranteed that the total sum of $$$n$$$ over test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case print the minimum possible height of a tree with the given visiting order $$$a$$$.

NoteIn the first test case, there is only one tree with the given visiting order:   In the second test case, there is only one tree with the given visiting order as well:   In the third test case, an optimal tree with the given visiting order is shown below:

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve = maximum . foldl f [0] . blocks . tail
  where
    f (d:ds) l = ds ++ replicate l (d + 1)

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs = go bs [0]
    -- f l ds = tail ds ++ replicate l (1 + head ds)
  where
    bs = blocks (tail xs)
    go [] ds = maximum ds
    -- go _ ds = maximum ds
    go (l:ls) ds = go ls (tail ds ++ replicate l (1 + head ds))

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve = maximum . foldl bfs [0] . blocks' . tail
  where
    bfs (d:ds) l = ds ++ replicate l (d + 1)

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

blocks' :: [Int] -> [Int]
blocks' xs = foldr f [1] $ zipWith (<) xs (tail xs)
  where
    f True (l:ls) = 1 + l : ls
    f False ls = 1 : ls

import Control.Arrow ((>>>))
import Data.Bool (bool)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve = maximum . foldl bfs [0] . blocks (<) . tail
  where
    bfs (d:ds) l = ds ++ replicate l (d + 1)

blocks :: (a -> a -> Bool) -> [a] -> [Int]
blocks f xs = foldr (bool appl incl) [1] $ zipWith f xs (tail xs)
  where
    appl = (1 :)
    incl (l:ls) = 1 + l : ls

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs = go (length xs) bs [0]
  where
    bs = blocks (tail xs)
    go _ [] ds = maximum ds
    go 0 _ ds = maximum ds
    go n (l:ls) ds = go (n - 1) ls (tail ds ++ replicate l (1 + head ds))

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs = go (length xs) bs [0]
  where
    bs = blocks (tail xs)
    go _ [] ds = maximum ds
    go 0 _ ds = maximum ds
    go n (l:ls) ds = go (n - 1) ls (tail ds ++ replicate l (1 + head ds))

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs = maximum $ foldl f [0] bs
  where
    bs = blocks (tail xs)
    f ds l = tail ds ++ replicate l (1 + head ds)
    --go [] ds = maximum ds
    --go (l:ls) ds = go ls (tail ds ++ replicate l (1 + head ds))

blocks :: [Int] -> [Int]
blocks [_] = [1]
blocks (x:x':xs)
  | x < x' = (1 + head ls) : tail ls
  | otherwise = 1 : ls
  where
    ls = blocks (x' : xs)

import Control.Monad
import qualified Data.Map as M

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- read <$> getLine :: IO Int
        bfs <- map read . words <$> getLine :: IO [Int]
        print $ solve (M.singleton 1 0) bfs (tail bfs) 0

solve :: M.Map Int Int -> [Int] -> [Int] -> Int -> Int
solve h _ [] _ = maximum $ M.elems h
solve h (x:xs) (y:ys) p
                    | y > p = solve (M.insert y (h M.! x + 1) h) (x:xs) ys y
                    | otherwise = solve h xs (y:ys) 0
solve _ _ _ _ = error "Solve called with invalid params"

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs = (+ 1) . length . filter id $ zipWith (>) xs (tail xs)


You are given three integers $$$a \le b \le c$$$.In one move, you can add $$$+1$$$ or $$$-1$$$ to any of these integers (i.e. increase or decrease any number by one). You can perform such operation any (possibly, zero) number of times, you can even perform this operation several times with one number. Note that you cannot make non-positive numbers using such operations.You have to perform the minimum number of such operations in order to obtain three integers $$$A \le B \le C$$$ such that $$$B$$$ is divisible by $$$A$$$ and $$$C$$$ is divisible by $$$B$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The next $$$t$$$ lines describe test cases. Each test case is given on a separate line as three space-separated integers $$$a, b$$$ and $$$c$$$ ($$$1 \le a \le b \le c \le 10^4$$$).

For each test case, print the answer. In the first line print $$$res$$$ — the minimum number of operations you have to perform to obtain three integers $$$A \le B \le C$$$ such that $$$B$$$ is divisible by $$$A$$$ and $$$C$$$ is divisible by $$$B$$$. On the second line print any suitable triple $$$A, B$$$ and $$$C$$$.

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, UnboxedTuples #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (a, b, c) <- liftM3 (,,) get get get
    let (n, x, y, z) = f2 a b c in
        do
            putln n
            putln [x, y, z]

f2 :: Int -> Int -> Int -> (Int, Int, Int, Int)
f2 a b c = foldl (\(n, x, y, z) i ->
        foldl (\(n, x, y, z) j ->
            let c1 = (div c j) * j in
            let c2 = (div c j) * j + j in
            let s1 = (abs (i - a) + abs (j - b) + abs (c1 - c)) in
            let (n1, x1, y1, z1) = if s1 < n then (s1, i, j, c1) else (n, x, y, z) in
            let s2 = (abs (i - a) + abs (j - b) + abs (c2 - c)) in
            if s2 < n1 then (s2, i, j, c2) else (n1, x1, y1, z1)
        ) (n, x, y, z) [i,2*i..2*b]
    ) (1000000, 0, 0, 0) [1..2*a]

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, UnboxedTuples #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (a, b, c) <- liftM3 (,,) get get get
    let (n, x, y, z) = f2 a b c in
        do
            putln n
            putln [x, y, z]

f2 :: Int -> Int -> Int -> (Int, Int, Int, Int)
f2 a b c = foldl (\(n, x, y, z) i ->
        foldl (\(n, x, y, z) j ->
        foldl (\(n, x, y, z) k ->
            let s = (abs (i - a)) + (abs (j - b)) + (abs (k - c)) in
            if s < n then (s, i, j, k) else (n, x, y, z)
        ) (n, x, y, z) [j,2*j..11000]
        ) (n, x, y, z) [i,2*i..11000]
    ) (1000000, 0, 0, 0) [1..10000]

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, UnboxedTuples #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (a, b, c) <- liftM3 (,,) get get get
    let (n, x, y, z) = f2 a b c in
        do
            putln n
            putln [x, y, z]

f2 :: Int -> Int -> Int -> (Int, Int, Int, Int)
f2 a b c = f3 a b c 0 1000000 0 0 0

f3 a b c i n x y z = if i >= a || i >= n
    then (n, x, y, z)
    else
        let (n1, x1, y1, z1) = f4 a b c (a + i) 0 n x y z in
        let (n2, x2, y2, z2) = f4 a b c (a - i) 0 n1 x1 y1 z1 in
        f3 a b c (i + 1) n2 x2 y2 z2

f4 a b c ai j n x y z = foldl (\(n, x, y, z) j ->
            let c1 = (div c j) * j in
            let c2 = (div c j) * j + j in
            let s1 = (abs (ai - a) + abs (j - b) + abs (c1 - c)) in
            let (n1, x1, y1, z1) = if s1 < n then (s1, ai, j, c1) else (n, x, y, z) in
            let s2 = (abs (ai - a) + abs (j - b) + abs (c2 - c)) in
            if s2 < n1 then (s2, ai, j, c2) else (n1, x1, y1, z1)
        ) (n, x, y, z) [ai,2*ai..2*b]

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, UnboxedTuples #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (a, b, c) <- liftM3 (,,) get get get
    let (n, x, y, z) = f2 a b c in
        do
            putln n
            putln [x, y, z]

f2 :: Int -> Int -> Int -> (Int, Int, Int, Int)
f2 a b c = f3 a b c 0 1000000 0 0 0

f3 a b c i n x y z = if i >= a || i >= n
    then (n, x, y, z)
    else
        let (n1, x1, y1, z1) = f4 a b c (a + i) 0 n x y z in
        let (n2, x2, y2, z2) = f4 a b c (a - i) 0 n1 x1 y1 z1 in
        f3 a b c (i + 1) n2 x2 y2 z2

f4 a b c ai j n x y z = let bk = (div b ai) in
    if ((bk + j) * ai >= 2 * b && bk <= j) || (
        (abs (ai - a) + abs ((bk + j) * ai - b)) > n &&
        (abs (ai - a) + abs ((bk - j) * ai - b)) > n &&
        (abs (ai - a) + abs ((bk + j + 1) * ai - b)) > n &&
        (abs (ai - a) + abs ((bk - j - 1) * ai - b)) > n) then (n, x, y, z)
    else
        let (n1, x1, y1, z1) = f5 a b c ai (max ((bk + j) * ai) 1) n x y z in
        let (n2, x2, y2, z2) = f5 a b c ai (max ((bk - j) * ai) 1) n1 x1 y1 z1 in
        f4 a b c ai (j + 1) n2 x2 y2 z2

f5 a b c ai bi n x y z =
            let c1 = (div c bi) * bi in
            let c2 = (div c bi) * bi + bi in
            let s1 = (abs (ai - a) + abs (bi - b) + abs (c1 - c)) in
            let (n1, x1, y1, z1) = if s1 < n then (s1, ai, bi, c1) else (n, x, y, z) in
            let s2 = (abs (ai - a) + abs (bi - b) + abs (c2 - c)) in
            if s2 < n1 then (s2, ai, bi, c2) else (n1, x1, y1, z1)


The Bitlandians are quite weird people. They do everything differently. They have a different alphabet so they have a different definition for a string.A Bitlandish string is a string made only of characters "0" and "1".BitHaval (the mayor of Bitland) loves to play with Bitlandish strings. He takes some Bitlandish string a, and applies several (possibly zero) operations to it. In one operation the mayor may take any two adjacent characters of a string, define one of them as x and the other one as y. Then he calculates two values p and q: p = x xor y, q = x or y. Then he replaces one of the two taken characters by p and the other one by q.The xor operation means the bitwise excluding OR operation. The or operation is the bitwise OR operation.So for example one operation can transform string 11 to string 10 or to string 01. String 1 cannot be transformed into any other string.You've got two Bitlandish strings a and b. Your task is to check if it is possible for BitHaval to transform string a to string b in several (possibly zero) described operations.

The first line contains Bitlandish string a, the second line contains Bitlandish string b. The strings can have different lengths. It is guaranteed that the given strings only consist of characters "0" and "1". The strings are not empty, their length doesn't exceed 106.

Print "YES" if a can be transformed into b, otherwise print "NO". Please do not print the quotes.

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  a <- C.getLine
  b <- C.getLine
  if C.length a == C.length b && C.elem '1' a == C.elem '1' b
    then putStrLn "YES"
    else putStrLn "NO"

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = putStrLn . solve . B.lines =<< B.getContents

solve :: [B.ByteString] -> String
solve (a : b : _)
  | B.length a == B.length b && B.elem '1' a == B.elem '1' b = "YES"
  | otherwise = "NO"

solve :: String -> String -> Bool
solve a b
  | length a /= length b  =  False
  | elem '1' a && elem '1' b  =  True
  | elem '1' a || elem '1' b  =  False
  | otherwise  =  True

main :: IO ()
main  =  do
    a  <-  getLine
    b  <-  getLine
    if solve a b then
        putStrLn "YES"
    else
        putStrLn "NO"

import Data.List

main = do
	start <- getLine
	end <- getLine
	putStrLn.format.not $ unconvertable start end

unconvertable a b =
	length a /= length b
	|| any (=='1') a && all (=='0') b
	|| (length a == 1 || all (=='0') a) && a /= b

format True = "YES"
format False = "NO"

import qualified Data.ByteString.Char8 as B

main=B.getContents>>=putStr.solve.B.words

solve[x,y]
  | B.length x == B.length y && B.elem '1' x == B.elem '1' y = "YES"
  | otherwise = "NO"

import Data.Char

main = interact $ solve . lines
    where
        solve (a:b:[])
            | (length a == length b) && scons (convert a) (convert b) = "YES"
            | otherwise = "NO"
        convert = foldl max 0 . map digitToInt
        scons 0 0 = True
        scons 1 1 = True
        scons _ _ = False

import Data.Char

main = interact $ solve . lines
    where
        solve (a:b:[])
            | (length a == length b) && (elem '1' a == elem '1' b) = "YES"
            | otherwise = "NO"

import Data.List

main = do
	start <- getLine
	end <- getLine
	putStrLn.format.not $ unconvertable start end

unconvertable a b =
	length a /= length b
	|| (any (=='1') a && all (=='0') b)
	|| length a == 1
	||  (all (=='0') a && a /= b)

format True = "YES"
format False = "NO"


Patrick has just finished writing a message to his sweetheart Stacey when he noticed that the message didn't look fancy. Patrick was nervous while writing the message, so some of the letters there were lowercase and some of them were uppercase.Patrick believes that a message is fancy if any uppercase letter stands to the left of any lowercase one. In other words, this rule describes the strings where first go zero or more uppercase letters, and then — zero or more lowercase letters.To make the message fancy, Patrick can erase some letter and add the same letter in the same place in the opposite case (that is, he can replace an uppercase letter with the lowercase one and vice versa). Patrick got interested in the following question: what minimum number of actions do we need to make a message fancy? Changing a letter's case in the message counts as one action. Patrick cannot perform any other actions.

The only line of the input contains a non-empty string consisting of uppercase and lowercase letters. The string's length does not exceed 105.

Print a single number — the least number of actions needed to make the message fancy.

import Data.Char

main = do
	s <- getLine

	let cs =  scanl (+) 0 $ map ((\b -> if b then 1 else 0) . isUpper) s
	print $ minimum $ map (\(c, i) -> (i-c) + ((last cs) - c)) $ zip cs [0..length s]

import Data.Char

main = do
	s <- getLine
	let cs = scanl (+) 0 $ map (fromEnum . isAsciiUpper) s
	print $ minimum $ map (\(i, c) -> (i-c) + ((last cs) - c)) $ zip [0..length s] cs

{-# LANGUAGE TypeApplications #-}

import Data.List (dropWhile, dropWhileEnd)
import Data.Char (isUpper, isLower)

main :: IO ()
main = do
  str <- dropWhileEnd isLower . dropWhile isUpper <$> getLine
  let uppers = length (filter isUpper str)
  print $ solve uppers uppers str

solve :: Int -> Int -> String -> Int
solve changes acc [] = minimum [acc, changes]
solve changes acc (x:xs) | isUpper x = solve (pred changes) (minimum [acc, pred changes]) xs
                         | otherwise = solve (succ changes) acc xs

{-# LANGUAGE TypeApplications #-}

import Data.List (dropWhile, dropWhileEnd)
import Data.Char (isUpper, isLower)

main :: IO ()
main = do
  str <- dropWhileEnd isLower . dropWhile isUpper <$> getLine
  let
    lowers = length (filter isLower str)
    uppers = length (filter isUpper str)
  print $ minimum [lowers, uppers]


Kuznecov likes art, poetry, and music. And strings consisting of lowercase English letters.Recently, Kuznecov has found two strings, $$$a$$$ and $$$b$$$, of lengths $$$n$$$ and $$$m$$$ respectively. They consist of lowercase English letters and no character is contained in both strings. Let another string $$$c$$$ be initially empty. Kuznecov can do the following two types of operations:  Choose any character from the string $$$a$$$, remove it from $$$a$$$, and add it to the end of $$$c$$$.  Choose any character from the string $$$b$$$, remove it from $$$b$$$, and add it to the end of $$$c$$$. But, he can not do more than $$$k$$$ operations of the same type in a row. He must perform operations until either $$$a$$$ or $$$b$$$ becomes empty. What is the lexicographically smallest possible value of $$$c$$$ after he finishes?A string $$$x$$$ is lexicographically smaller than a string $$$y$$$ if and only if one of the following holds: $$$x$$$ is a prefix of $$$y$$$, but $$$x \neq y$$$;  in the first position where $$$x$$$ and $$$y$$$ differ, the string $$$x$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$y$$$.

There are several test cases in the input data. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. This is followed by the test cases description. The first line of each test case contains three integers $$$n$$$, $$$m$$$, and $$$k$$$ ($$$1\leq n,m,k \leq 100$$$) — parameters from the statement. The second line of each test case contains the string $$$a$$$ of length $$$n$$$. The third line of each test case contains the string $$$b$$$ of length $$$m$$$.  The strings contain only lowercase English letters. It is guaranteed that no symbol appears in $$$a$$$ and $$$b$$$ simultaneously.

In each test case, output a single string $$$c$$$ — the answer to the problem.

3

6 4 2

aaaaaa

bbbb

5 9 3

caaca

bedededeb

7 7 1

noskill

wxhtzdy

NoteIn the first test case, it is optimal to take two 'a's from the string $$$a$$$ and add them to the string $$$c$$$. Then it is forbidden to take more characters from $$$a$$$, hence one character 'b' from the string $$$b$$$ has to be taken. Following that logic, we end up with $$$c$$$ being 'aabaabaa' when string $$$a$$$ is emptied.In the second test case it is optimal to take as many 'a's from string $$$a$$$ as possible, then take as many 'b's as possible from string $$$b$$$. In the end, we take two 'c's from the string $$$a$$$ emptying it.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> String -> Int -> String -> Int -> String
solve n a m b k = solve' 0 0 (sort a) (sort b)
    where
        solve' :: Int -> Int -> String -> String -> String
        solve' i c sa sb
            | L.null sa || L.null sb = []
        solve' i c sa@(ca:otherA) sb@(cb:otherB)
            | ca > cb = solve' (1 - i) c sb sa
            | i == 0 && c >= k = cb : solve' 1 1 sa otherB
            | i == 1 = ca : solve' 0 1 otherA sb
            | otherwise = ca : solve' 0 (c + 1) otherA sb

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m, k] <- B8.getLine <&> readIntB8s
        a <- B8.getLine <&> B8.unpack . L.head . B8.words
        b <- B8.getLine <&> B8.unpack . L.head . B8.words
        let answer = solve n a m b k
        putStrLn answer


In a certain video game, the player controls a hero characterized by a single integer value: power. The hero will have to beat monsters that are also characterized by a single integer value: armor.On the current level, the hero is facing $$$n$$$ caves. To pass the level, the hero must enter all the caves in some order, each cave exactly once, and exit every cave safe and sound. When the hero enters cave $$$i$$$, he will have to fight $$$k_i$$$ monsters in a row: first a monster with armor $$$a_{i, 1}$$$, then a monster with armor $$$a_{i, 2}$$$ and so on, finally, a monster with armor $$$a_{i, k_i}$$$.The hero can beat a monster if and only if the hero's power is strictly greater than the monster's armor. If the hero can't beat the monster he's fighting, the game ends and the player loses. Note that once the hero enters a cave, he can't exit it before he fights all the monsters in it, strictly in the given order.Each time the hero beats a monster, the hero's power increases by $$$1$$$.Find the smallest possible power the hero must start the level with to be able to enter all the caves in some order and beat all the monsters.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^5$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of caves. The $$$i$$$-th of the next $$$n$$$ lines contains an integer $$$k_i$$$ ($$$1 \le k_i \le 10^5$$$) — the number of monsters in the $$$i$$$-th cave, followed by $$$k_i$$$ integers $$$a_{i, 1}, a_{i, 2}, \ldots, a_{i, k_i}$$$ ($$$1 \le a_{i, j} \le 10^9$$$) — armor levels of the monsters in cave $$$i$$$ in order the hero has to fight them. It is guaranteed that the sum of $$$k_i$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the smallest possible power the hero must start the level with to be able to enter all the caves in some order and beat all the monsters.

NoteIn the first test case, the hero has to beat a single monster with armor $$$42$$$, it's enough to have power $$$43$$$ to achieve that.In the second test case, the hero can pass the level with initial power $$$13$$$ as follows:   enter cave $$$2$$$:   beat a monster with armor $$$12$$$, power increases to $$$14$$$;  beat a monster with armor $$$11$$$, power increases to $$$15$$$;   enter cave $$$1$$$:   beat a monster with armor $$$10$$$, power increases to $$$16$$$;  beat a monster with armor $$$15$$$, power increases to $$$17$$$;  beat a monster with armor $$$8$$$, power increases to $$$18$$$.

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.Bifunctor (second)
import Data.List (sort)

main :: IO ()
main = C.interact $ runScanner (numberOf testCase) >>> map (solve >>> showB) >>> C.unlines

type Level = [Int]

testCase :: Scanner [Level]
testCase = numberOf (numberOf int)

solve :: [Level] -> Int
solve = (1 +) . maximum . uncurry (zipWith (-)) . second (scanl (+) 0) . unzip . sort . map info
  where
    info as = (maximum $ zipWith (-) as [0..], length as)

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


You're given an array $$$a$$$. You should repeat the following operation $$$k$$$ times: find the minimum non-zero element in the array, print it, and then subtract it from all the non-zero elements of the array. If all the elements are 0s, just print 0.

The first line contains integers $$$n$$$ and $$$k$$$ $$$(1 \le n,k \le 10^5)$$$, the length of the array and the number of operations you should perform. The second line contains $$$n$$$ space-separated integers $$$a_1, a_2, \ldots, a_n$$$ $$$(1 \le a_i \le 10^9)$$$, the elements of the array.

Print the minimum non-zero element before each operation in a new line.

NoteIn the first sample:In the first step: the array is $$$[1,2,3]$$$, so the minimum non-zero element is 1.In the second step: the array is $$$[0,1,2]$$$, so the minimum non-zero element is 1.In the third step: the array is $$$[0,0,1]$$$, so the minimum non-zero element is 1.In the fourth and fifth step: the array is $$$[0,0,0]$$$, so we printed 0.In the second sample:In the first step: the array is $$$[10,3,5,3]$$$, so the minimum non-zero element is 3.In the second step: the array is $$$[7,0,2,0]$$$, so the minimum non-zero element is 2.

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

toint s = (read s) :: Int

doit 0 a s = ""
doit k a [] = "0\n" ++ doit (k-1) a []
doit k a (x:xs) =
  if x > a then
    show(x-a)++"\n"++(doit (k-1) x xs)
  else
    doit k a xs

solve::String -> String
solve ss =
  let n:k:sss = map toint $ words ss in
  let s = sort $ take n sss in
  doit k 0 s

main = do
  interact $ solve

import Control.Monad
import qualified Data.Set as S
main = do
  [n,k] <- getLine >>= return . map (read :: String -> Int) . words
  as' <- getLine >>= return . S.fromList . map (read :: String -> Int) . words
  let as = S.toList as'
  print $ head as
  mapM_ print $ take (pred k) $ (zipWith (-) (tail as) as)
  mapM_ print $ take (k-length as) $ cycle [0]

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord

main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  as <- unfoldr (BS.readInt . BS.dropWhile (==' ')) <$> BS.getLine :: IO [Int]
  let as' = sort as
      subs = dropWhile (== 0) $ zipWith (-) as' (0:as')
      rep = map head' $ iterate (\xs -> remv xs (head' xs)) subs
  mapM_ print $ take k rep

remv :: [Int] -> Int -> [Int]
remv [] !y = []
remv xs'@(!x:xs) !y
  | x > y = (x-y):xs
  | otherwise = remv xs (y-x)

head' :: [Int] -> Int
head' [] = 0
head' (x:_) = x

import Data.List

main = do
    string <- getContents
    let answers = solve string
    sequence (map (putStrLn.show) answers)

solve string = let n = read sn :: Int; k = read sk :: Int in computeAnswer k [read s :: Int | s <- rest]
	       where (sn:sk:rest) = words string

computeAnswer k a = let b = sort a in getK k$head b:zipWith (-) (tail b) b
getK 0 _ = []
getK k [] = replicate k 0
getK k (x:xs) | x == 0 = getK k xs
	      | otherwise =  x : getK (k - 1) xs