One beautiful day Vasily the bear painted 2m circles of the same radius R on a coordinate plane. Circles with numbers from 1 to m had centers at points (2R - R, 0), (4R - R, 0), ..., (2Rm - R, 0), respectively. Circles with numbers from m + 1 to 2m had centers at points (2R - R, 2R), (4R - R, 2R), ..., (2Rm - R, 2R), respectively. Naturally, the bear painted the circles for a simple experiment with a fly. The experiment continued for m2 days. Each day of the experiment got its own unique number from 0 to m2 - 1, inclusive. On the day number i the following things happened:   The fly arrived at the coordinate plane at the center of the circle with number  ( is the result of dividing number x by number y, rounded down to an integer).  The fly went along the coordinate plane to the center of the circle number  ( is the remainder after dividing number x by number y). The bear noticed that the fly went from the center of circle v to the center of circle u along the shortest path with all points lying on the border or inside at least one of the 2m circles. After the fly reached the center of circle u, it flew away in an unknown direction. Help Vasily, count the average distance the fly went along the coordinate plane during each of these m2 days.

The first line contains two integers m, R (1 ≤ m ≤ 105, 1 ≤ R ≤ 10).

In a single line print a single real number — the answer to the problem. The answer will be considered correct if its absolute or relative error doesn't exceed 10 - 6.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (forM, liftM)
import Text.Printf (printf)

toDouble :: Int -> Double
toDouble = fromIntegral

main = do
  [m, r] <- liftM (map read . words) getContents
  let radius    = toDouble r
      near      = 2.0 * radius
      neighbour = 2.0 * radius + radius * (sqrt 2.0)
      far       = radius + radius * 2.0 * (sqrt 2.0)

  distances <- forM [1 .. m] $ \i -> do
    let numNear  = 1.0
        numNeighbour | m == 1           = 0.0
                     | i == 1 || i == m = 1.0
                     | otherwise        = 2.0
        farLeft  = toDouble $ max (i - 2) 0
        farRight = toDouble $ max (m - i - 1) 0
        distance = numNear * near +
                   numNeighbour * neighbour +
                   (far * farLeft + radius * farLeft * farLeft) +
                   (far * farRight + radius * farRight * farRight)
    return (distance / (toDouble m))
  let result = (sum distances) / (toDouble m)
  printf "%.9f\n" result

import Text.Printf

solve :: Int -> Int -> Int -> Double
solve m r i
	| (i<=m) = 2.0  +
		(if (i>1) then (2+sqrt 2) else 0) +
		(if (i>2) then (((fromIntegral (i-1))*(fromIntegral (i-2))) + (fromIntegral (i-2))*2.0*sqrt 2) else 0) +
		(if (i<m-1) then ((fromIntegral (m-i))*(fromIntegral (m-i-1))) + (fromIntegral (m-i-1))*2.0*sqrt 2 else 0) +
		(if (i<m) then 2 + sqrt 2 else 0) +
		(solve m r (i+1))
	| otherwise = 0.0

solution :: Int -> Int -> Double
solution m r =
	(solve m r 1) * (fromIntegral r) / (fromIntegral m)**2

main :: IO ()
main = do
	nStr <- getLine
	let [m, r] = map read $ words nStr
	printf "%.10f\n" $ solution m r

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

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

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

newtype State s a = State { runState :: s -> (a,s) }
newtype Identity a = Identity { runIdentity :: a }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

instance Applicative Identity where
    pure = return
    (<*>) = ap

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Double where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

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

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

itof :: Int -> Double
itof = fromIntegral

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

solve :: Int -> Double -> Double
solve m r = r * (sum [memo ! i +  memo ! (m-i-1) - 2| i <- [0..m-1]] / (itof m)^2)
    where
    memo :: UArray Int Double
    memo = fixMemoUArray (0,m-1) $ \f i -> case i of
        0 -> pure $ 2
        1 -> pure $ 4+sqrt 2
        i -> ((+) $ 2* itof (i-1) + 2*sqrt 2) <$> f (i-1)

main = do
    [m,r] <- readsLine
    print $ solve m (itof r)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (forM, liftM)
import Text.Printf (printf)

toDouble :: Int -> Double
toDouble = fromIntegral

main = do
  [m, r] <- liftM (map read . words) getContents
  let radius    = toDouble r
      near      = 2.0 * radius
      neighbour = 2.0 * radius + radius * (sqrt 2.0)
      far       = 2.0 * radius + radius * 2.0 * (sqrt 2.0)

  distances <- forM [1 .. m] $ \i -> do
    let numNear  = 1.0
        numNeighbour | m == 1           = 0.0
                     | i == 1 || i == m = 1.0
                     | otherwise        = 2.0
        farLeft  = toDouble $ max (i - 2) 0
        farRight = toDouble $ max (m - i - 1) 0
        distance = numNear * near +
                   numNeighbour * neighbour +
                   (far * farLeft + radius * farLeft * farLeft) +
                   (far * farRight + radius * farRight * farRight)
    return (distance / (toDouble m))
  let result = (sum distances) / (toDouble m)
  printf "%.9f\n" result

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

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

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

newtype State s a = State { runState :: s -> (a,s) }
newtype Identity a = Identity { runIdentity :: a }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

instance Applicative Identity where
    pure = return
    (<*>) = ap

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Double where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

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

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

itof :: Int -> Double
itof = fromIntegral

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

solve :: Int -> Double -> Double
solve m r = sum [ memo ! i +  memo ! (m-i-1) - memo ! 0 | i <- [0..m-1]] / (itof m)^2
    where
    memo :: UArray Int Double
    memo = fixMemoUArray (0,m-1) $ \f i -> case i of
        0 -> pure $ 2*r
        i -> (\a -> a + 2*(itof i)*r + r*sqrt 2) <$> f (i-1)

main = do
    [m,r] <- readsLine
    print $ solve m (itof r)

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

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

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

newtype State s a = State { runState :: s -> (a,s) }
newtype Identity a = Identity { runIdentity :: a }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

instance Applicative Identity where
    pure = return
    (<*>) = ap

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

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

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

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

itof :: Int -> Double
itof = fromIntegral

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

distance :: Double -> Double -> Double
distance m r = sum [ 2 * r + i * 2 * r - if i == 0 then 0 else (2*r - r* sqrt 2) | i <- [0..m-1]] / m

main = do
    [m,r] <- readsLine
    print $ distance m r

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

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

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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

newtype State s a = State { runState :: s -> (a,s) }
newtype Identity a = Identity { runIdentity :: a }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    x >>= f  = State $ \s ->
        let (a,s') = runState x s in runState (f a) s'

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

instance Applicative Identity where
    pure = return
    (<*>) = ap

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Double where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray
readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

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

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

itof :: Int -> Double
itof = fromIntegral

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

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

solve :: Int -> Double -> Double
solve m r = sum [ memo ! i +  memo ! (m-i-1) - memo ! 0 | i <- [0..m-1]] / (itof m)^2
    where
    memo :: UArray Int Double
    memo = fixMemoUArray (0,m-1) $ \f i -> case i of
        0 -> pure $ 2*r
        i -> (\a -> a + (2*(itof i)*r + r*sqrt 2)) <$> f (i-1)

main = do
    [m,r] <- readsLine
    print $ solve m (itof r)

import Control.Monad (liftM)
import Prelude hiding (reads)

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

reads' :: Read a => IO [a]
reads'  =  liftM (map read . words) (readFile "input.txt")

solve :: [Double] -> Double
solve [1, r]  =  2 * r
solve [n, r]  =  k * r / (n^2)
  where
    k  =  2 * n + (2 * (n - 1) * (2 + sqrt 2)) + sum [2 * (n - i) * (2 * (i - 2) + 2 * sqrt 2) | i <- [3..n]]

main :: IO ()
main  =  reads >>= print . solve


For an array $$$[b_1, b_2, \ldots, b_m]$$$ define its number of inversions as the number of pairs $$$(i, j)$$$ of integers such that $$$1 \le i < j \le m$$$ and $$$b_i>b_j$$$. Let's call array $$$b$$$ odd if its number of inversions is odd. For example, array $$$[4, 2, 7]$$$ is odd, as its number of inversions is $$$1$$$, while array $$$[2, 1, 4, 3]$$$ isn't, as its number of inversions is $$$2$$$.You are given a permutation $$$[p_1, p_2, \ldots, p_n]$$$ of integers from $$$1$$$ to $$$n$$$ (each of them appears exactly once in the permutation). You want to split it into several consecutive subarrays (maybe just one), so that the number of the odd subarrays among them is as large as possible. What largest number of these subarrays may be odd?

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$)  — the number of test cases. The 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 size of the permutation. The second line of each test case contains $$$n$$$ integers $$$p_1, p_2, \ldots, p_n$$$ ($$$1 \le p_i \le n$$$, all $$$p_i$$$ are distinct)  — the elements of the permutation. The sum of $$$n$$$ over all test cases doesn't exceed $$$2\cdot 10^5$$$.

For each test case output a single integer  — the largest possible number of odd subarrays that you can get after splitting the permutation into several consecutive subarrays.

NoteIn the first and third test cases, no matter how we split our permutation, there won't be any odd subarrays.In the second test case, we can split our permutation into subarrays $$$[4, 3], [2, 1]$$$, both of which are odd since their numbers of inversions are $$$1$$$.In the fourth test case, we can split our permutation into a single subarray $$$[2, 1]$$$, which is odd.In the fifth test case, we can split our permutation into subarrays $$$[4, 5], [6, 1, 2, 3]$$$. The first subarray has $$$0$$$ inversions, and the second has $$$3$$$, so it is odd.

{-# LANGUAGE Strict  #-}

import Control.Monad (replicateM, replicateM_)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

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

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  ps <- readInts <$> B8.getLine :: IO [Int]
  print $ solve ps

solve :: [Int] -> Int
solve []  = 0
solve [p] = 0
solve (p:pp:ps) = if p > pp then 1 + solve ps else solve (pp:ps)

-- solve !n []  = n
-- solve !n [p] = n
-- solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

{-# LANGUAGE Strict  #-}

import Control.Monad (replicateM, replicateM_)

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

run :: IO ()
run = do
  n <- readLn :: IO Int
  ps <- map read . words <$> getLine :: IO [Int]
  print $ solve ps

solve :: [Int] -> Int
solve []  = 0
solve [p] = 0
solve (p:pp:ps) = if p > pp then 1 + solve ps else solve (pp:ps)

-- solve !n []  = n
-- solve !n [p] = n
-- solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

{-# LANGUAGE Strict  #-}

import Control.Monad (replicateM, replicateM_)

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

run :: IO ()
run = do
  n <- readLn :: IO Int
  ps <- map read . words <$> getLine :: IO [Int]
  print $ solve 0 ps

solve :: Int -> [Int] -> Int
solve n []  = n
solve n [p] = n
solve n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

-- solve !n []  = n
-- solve !n [p] = n
-- solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

{-# LANGUAGE BangPatterns  #-}

import Control.Monad (replicateM, replicateM_)

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

run :: IO ()
run = do
  n <- readLn :: IO Int
  ps <- seq () $  map read . words <$> getLine :: IO [Int]
  print $ solve 0 ps

solve :: Int -> [Int] -> Int
solve !n []  = n
solve !n [p] = n
solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

{-# LANGUAGE BangPatterns  #-}

import Control.Monad (replicateM, replicateM_)

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

run :: IO ()
run = do
  n <- readLn :: IO Int
  ps <-  map read . words <$> getLine :: IO [Int]
  print $ solve 0 ps

solve :: Int -> [Int] -> Int
solve !n []  = n
solve !n [p] = n
solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

{-# LANGUAGE BangPatterns  #-}

import Control.Monad (replicateM)

main :: IO ()
main = do
  t <- readLn :: IO Int
  res <- replicateM t run
  putStrLn . unlines $ res

run :: IO String
run = do
  n <- readLn :: IO Int
  ps <-  map read . words <$> getLine :: IO [Int]
  return . show $ solve 0 ps

solve :: Int -> [Int] -> Int
solve !n []  = n
solve !n [p] = n
solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve n (pp:ps)

import Control.Monad (replicateM)

main :: IO ()
main = do
  t <- readLn :: IO Int
  res <- replicateM t run
  putStrLn . unlines $ res

run :: IO String
run = do
  n <- readLn :: IO Int
  ps <-  map read . words <$> getLine :: IO [Int]
  return . show $ solve ps

solve :: [Int] -> Int
solve []  = 0
solve [p] = 0
solve (p:pp:ps) = if p > pp then 1 + solve ps else solve (pp:ps)

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>=
        \n -> map read . words <$> getLine >>=
        print . maxOdd n

maxOdd :: Int -> [Int] -> Int
maxOdd n ps = m ps 0

m :: [Int] -> Int -> Int
m [] acc = acc
m [_] acc = acc
m (p1:p2:ps) acc | p1 < p2 = m (p2:ps) acc
                 | p1 >= p2 = m ps (acc+1)

-- https://codeforces.com/contest/1679/problem/D
{-# 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.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.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 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 -> [Int] -> Int
solve 0 _ = 0
solve 1 _ = 0
solve n as@(a1:a2:otherAs) | a1 > a2 = 1 + solve (n - 2) otherAs
solve n as@(_:otherAs) = solve (n - 1) otherAs

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer

{-# LANGUAGE BangPatterns  #-}

import Control.Monad (replicateM)

main :: IO ()
main = do
  t <- readLn :: IO Int
  res <- replicateM t run
  putStrLn . unlines $ res

run :: IO String
run = do
  n <- readLn :: IO Int
  ps <-  map read . words <$> getLine :: IO [Int]
  return . show $ solve 0 ps

solve :: Int -> [Int] -> Int
solve !n []  = n
solve !n [p] = n
solve !n (p:pp:ps) = if p > pp then solve (n+1) ps else solve (n+1) (pp:ps)


Eikooc and Sushi play a game.The game is played on a tree having $$$n$$$ nodes numbered $$$1$$$ to $$$n$$$. Recall that a tree having $$$n$$$ nodes is an undirected, connected graph with $$$n-1$$$ edges.They take turns alternately moving a token on the tree. Eikooc makes the first move, placing the token on any node of her choice. Sushi makes the next move, followed by Eikooc, followed by Sushi, and so on. In each turn after the first, a player must move the token to a node $$$u$$$ such that   $$$u$$$ is adjacent to the node $$$v$$$ the token is currently on  $$$u$$$ has not been visited before  $$$u \oplus v \leq min(u, v)$$$ Here $$$x \oplus y$$$ denotes the bitwise XOR operation on integers $$$x$$$ and $$$y$$$.Both the players play optimally. The player who is unable to make a move loses.The following are examples which demonstrate the rules of the game.     Suppose Eikooc starts the game by placing the token at node $$$4$$$. Sushi then moves the token to node $$$6$$$, which is unvisited and adjacent to $$$4$$$. It also holds that $$$6 \oplus 4 = 2 \leq min(6, 4)$$$. In the next turn, Eikooc moves the token to node $$$5$$$, which is unvisited and adjacent to $$$6$$$. It holds that $$$5 \oplus 6 = 3 \leq min(5, 6)$$$. Sushi has no more moves to play, so she loses.   Suppose Eikooc starts the game by placing the token at node $$$3$$$. Sushi moves the token to node $$$2$$$, which is unvisited and adjacent to $$$3$$$. It also holds that $$$3 \oplus 2 = 1 \leq min(3, 2)$$$. Eikooc cannot move the token to node $$$6$$$ since $$$6 \oplus 2 = 4 \nleq min(6, 2)$$$. Since Eikooc has no moves to play, she loses. Before the game begins, Eikooc decides to sneakily relabel the nodes of the tree in her favour. Formally, a relabeling is a permutation $$$p$$$ of length $$$n$$$ (sequence of $$$n$$$ integers wherein each integer from $$$1$$$ to $$$n$$$ occurs exactly once) where $$$p_i$$$ denotes the new numbering of node $$$i$$$.She wants to maximize the number of nodes she can choose in the first turn which will guarantee her a win. Help Eikooc find any relabeling which will help her do so.

The first line contains a single integer $$$t~(1 \le t \le 10^5)$$$  — the number of test cases. The description of each test case is as follows. The first line of each test case contains an integer $$$n~(1 \le n \le 2 \cdot 10^5)$$$  — the number of nodes in the tree. The next $$$n-1$$$ lines contain two integers $$$u$$$ and $$$v$$$ $$$(1 \le u, v \le n; u \neq v)$$$  — denoting an edge between nodes $$$u$$$ and $$$v$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print any suitable relabeling  — a permutation of length $$$n$$$ which maximizes the number of nodes that can be chosen in the first turn that guarantee a win for Eikooc. If there are multiple such relabelings, you may print any of them.

NoteIn the first test case, Eikooc has only one choice. Sushi will have no moves to play after Eikooc chooses this node and Eikooc will win.In the second test case, $$$1 \oplus 2 = 3 \nleq min(1, 2)$$$. Hence, after Eikooc picks either of the nodes, Sushi will have no moves to play and Eikooc will win. Both $$$\{1, 2\}$$$ and $$$\{2, 1\}$$$ are optimal relabelings.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.IntSet as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    ps2 = concat [[(x,y),(y,x)] | (x,y)<-ps]
    adjArr = DA.accumArray (flip (:)) [] (1,n) ps2
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    wl = DS.size whites
    wlabels = concat [[x..2*x-1] | i<-[0..DB.finiteBitSize wl], DB.testBit wl i, let x=DB.shift 1 i]
    blabels = concat [[x..2*x-1] | i<-[0..DB.finiteBitSize wl], not (DB.testBit wl i), let x=DB.shift 1 i]
    unsortedAns = zip (DS.toList whites ++ DS.toList blacks) (wlabels++blabels)
    ans = DA.elems $ DA.accumArray (+) 0 (1,n) unsortedAns
  in Output ans

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.IntSet as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    ps2 = concat [[(x,y),(y,x)] | (x,y)<-ps]
    adjArr = DA.accumArray (flip (:)) [] (1,n) ps2
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    wl = DS.size whites
    wlabels = concat [[2^i..(2^(i+1)-1)] | i<-[0..DB.finiteBitSize wl], DB.testBit wl i]
    blabels = concat [[2^i..(2^(i+1)-1)] | i<-[0..DB.finiteBitSize wl], not (DB.testBit wl i)]
    unsortedAns = zip (DS.toList whites ++ DS.toList blacks) (wlabels++blabels)
    ans = DA.elems $ DA.accumArray (+) 0 (1,n) unsortedAns
  in Output ans

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.IntSet as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    ps2 = concat [[(x,y),(y,x)] | (x,y)<-ps]
    adjArr = DA.accumArray (flip (:)) [] (1,n) ps2
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    inversePerm = merge (DS.toList whites) (DS.toList blacks) 1 (DS.size whites) []
    perm = fmap snd $ DL.sort $ zip inversePerm [1..]
  in Output perm

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.Set as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    ps2 = concat [[(x,y),(y,x)] | (x,y)<-ps]
    adjArr = DA.accumArray (flip (:)) [] (1,n) ps2
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    inversePerm = merge (DS.toList whites) (DS.toList blacks) 1 (DS.size whites) []
    perm = fmap snd $ DL.sort $ zip inversePerm [1..]
  in Output perm

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Set as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    adjMap = DM.fromListWith (++) $ concat [[(x,[y]),(y,[x])] | (x,y)<-ps]
    sureLookup x m =  fromMaybe [] $ DM.lookup x m
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (sureLookup node adjMap)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    inversePerm = merge (DS.toList whites) (DS.toList blacks) 1 (DS.size whites) []
    perm = fmap snd $ DL.sort $ zip inversePerm [1..]
  in Output perm

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.Array
import Data.Bits
import Data.Graph
import Data.List
import Data.Maybe
import qualified Data.IntSet as IS
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    eds <- fmap concat $ replicateM (n - 1) $ do
        ~[u, v] <- readInts
        pure [(u, v), (v, u)]
    let (xs, ys) = if length xs' < length ys' then (xs', ys') else (ys', xs') where
            (xs', ys') = partition (p!) [1..n]
            p = array (1, n) $ parity t
            [t] = dfs (buildG (1, n) eds) [1]
        lxs = length xs
        pxs = concatMap generate $ filter (testBit lxs) [0 .. finiteBitSize lxs - 1]
        pys = filter (`IS.notMember` s) [1..n] where s = IS.fromList pxs
        ans = array (1, n) $ zip (xs ++ ys) (pxs ++ pys)
    putStrLn $ unwords $ map show $ elems ans

generate :: Int -> [Int]
generate i = [bit i .. bit (i + 1) - 1]

parity :: Tree a -> [(a, Bool)]
parity t = go False t [] where
    go p (Node u ts) acc = (u, p) : foldr (go $ not p) acc ts

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

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

import Control.Monad
import Data.Array
import Data.Bits
import Data.Graph
import Data.List
import Data.Maybe
import qualified Data.IntSet as IS
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    eds <- fmap concat $ replicateM (n - 1) $ do
        ~[u, v] <- readInts
        pure [(u, v), (v, u)]
    let g = buildG (1, n) eds
        [t] = dfs g [1]
        (xs, ys) = if length xs' < length ys' then (xs', ys') else (ys', xs') where
            (xs', ys') = partition (p!) [1..n]
            p = array (1, n) $ parity t
        lxs = length xs
        (gr, grs) = (gr, reverse grs') where
            gr:grs' = groups n
        pxs = concatMap (grs!!) $ filter (testBit lxs) [0 .. length grs - 1]
        pys = filter (`IS.notMember` s) [1..n] where s = IS.fromList pxs
        ans = array (1, n) $ zip (xs ++ ys) (pxs ++ pys)
    putStrLn $ unwords $ map show $ elems ans

groups :: Int -> [[Int]]
groups 0 = []
groups n = [n, n-1 .. m] : groups (m - 1) where
    m = bit (highestSetBit n)

parity :: Tree a -> [(a, Bool)]
parity t = go False t [] where
    go p (Node u ts) acc = (u, p) : foldr (go $ not p) acc ts

highestSetBit :: Int -> Int
highestSetBit n = finiteBitSize n - countLeadingZeros n - 1

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

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

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.IntSet as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    ps2 = concat [[(x,y),(y,x)] | (x,y)<-ps]
    adjArr = DA.accumArray (flip (:)) [] (1,n) ps2
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    wl = DS.size whites
    wlabels = concat [[2^i..(2*(i+1)-1)] | i<-[0..DB.finiteBitSize wl], DB.testBit wl i]
    blabels = concat [[2^i..(2*(i+1)-1)] | i<-[0..DB.finiteBitSize wl], not (DB.testBit wl i)]
    unsortedAns = zip (DS.toList whites ++ DS.toList blacks) (wlabels++blabels)
    ans = DA.elems $ DA.accumArray (+) 0 (1,n) unsortedAns
  in Output ans

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Strict as DM
import qualified Data.Array as DA
import qualified Data.Set as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    pssp = ps ++ reverse ps
    adjArr = DA.accumArray (flip (:)) [] (1,n) pssp
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (adjArr DA.! node)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    inversePerm = merge (DS.toList whites) (DS.toList blacks) 1 (DS.size whites) []
    perm = fmap snd $ DL.sort $ zip inversePerm [1..]
  in Output perm

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  !ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.Map.Lazy as DM
import qualified Data.Set as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    adjMap = DM.fromListWith (++) [(x,[y]) | (x,y)<-ps]
    sureLookup x m =  fromMaybe [] $ DM.lookup x m
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (sureLookup node adjMap)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    inversePerm = merge (DS.toList whites) (DS.toList blacks) 1 (DS.size whites) []
    perm = fmap snd $ DL.sort $ zip inversePerm [1..]
  in Output perm

merge :: [a] -> [a] -> Int -> Int -> [a] -> [a]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl  = merge ws (b:bs) (m+1) wl (w:ans)
  | otherwise         = merge (w:ws) bs (m+1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m+1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m+1) wl (w:ans)
merge _ _ _ _ ans = reverse ans

lg :: Int->Int
lg x = DB.finiteBitSize x - DB.countLeadingZeros x - 1

ithlsb :: Int -> Int -> Bool
ithlsb i n = DB.testBit n i

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.Map.Lazy as DM
import qualified Data.Set as DS
import qualified Data.List as DL
data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    pssp = ps ++ [(y,x) | (x,y)<-ps]
    adjMap = DM.fromListWith (++) [(x,[y]) | (x,y)<-pssp]
    sureLookup x m =  fromMaybe [] $ DM.lookup x m
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (sureLookup node adjMap)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    perm = merge (DS.toList whites) (DS.toList blacks) n (DS.size whites) []
  in Output perm

merge :: Integral a1 => [a2] -> [a2] -> a1 -> a1 -> [a2] -> [a2]
merge (w:ws) (b:bs) m wl ans
  | ithlsb (lg m) wl == 1 = merge ws (b:bs) (m-1) wl (w:ans)
  | otherwise             = merge (w:ws) bs (m-1) wl (b:ans)
merge [] (b:bs) m wl ans = merge [] bs (m-1) wl (b:ans)
merge (w:ws) [] m wl ans = merge ws [] (m-1) wl (w:ans)
merge _ _ _ _ ans = ans

lg :: Integral t => t -> t
lg 1 = 0
lg n = 1 + lg (n`div`2)

ithlsb :: Integral t => t -> t -> t
ithlsb 0 n = n`mod`2
ithlsb i n = ithlsb (i-1) (n`div`2)

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.Map.Lazy as DM
import qualified Data.Set as DS
import qualified Data.List as DL

data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

solve :: Input -> Output
solve (Input n ps) = let
    pssp = ps ++ [(y,x) | (x,y)<-ps]
    adjMap = DM.fromListWith (++) [(x,[y]) | (x,y)<-pssp]
    sureLookup x m =  fromMaybe [] $ DM.lookup x m
    colorSubtree color node [ws,bs]
      | DS.member node ws || DS.member node bs = [ws,bs]
      | otherwise = foldr (colorSubtree (1-color)) (add node color [ws,bs]) (sureLookup node adjMap)
    add node color [c0,c1] = if color==0 then [DS.insert node c0,c1] else [c0,DS.insert node c1]
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorSubtree 0 1 [DS.empty,DS.empty]
    wsbs = DS.toList whites ++ DS.toList blacks
    wsbsns = zip wsbs [1..]
    nswsbs = DL.sort wsbsns
    perm = map snd nswsbs
  in Output perm

input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import System.IO
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.Map.Lazy as DM
import qualified Data.Set as DS
import qualified Data.List as DL

data Input = Input {ne :: Int, pairs :: [(Int,Int)]}
data Output = Output [Int] deriving Show

sureLookup :: (Integral a, Ord k) => k -> DM.Map k [a] -> [a]
sureLookup x m =  fromMaybe [] $ DM.lookup x m

solve :: Input -> Output
solve (Input n ps) = let
    pssp = ps ++ [(y,x) | (x,y)<-ps]
    adjMap = DM.fromListWith (++) [(x,[y]) | (x,y)<-pssp]
    colorAdj self adj [ws,bs]
      | DS.notMember adj ws && DS.notMember self bs = if DS.member self ws then [ws,DS.insert adj bs] else [DS.insert adj ws,bs]
      | otherwise = [ws,bs]
    colorAdjs self = foldr (colorAdj self) [DS.fromList [1], DS.empty] (sureLookup self adjMap)
    [whites,blacks] = DL.sortBy (compare `on` DS.size) $ colorAdjs 1
    wsbs = DS.toList whites ++ DS.toList blacks
    wsbsns = zip wsbs [1..]
    nswsbs = DL.sort wsbsns
    perm = map snd nswsbs
  in Output perm

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  n <- getIntegral
  ps <- replicateM (n-1) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output xs) = mconcat [dec x <> sp| x<-xs] <> nl

numberOfTestcases :: St Int
numberOfTestcases = explicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.Array
import Data.Bits
import Data.Graph
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    eds <- fmap concat $ replicateM (n - 1) $ do
        ~[u, v] <- readInts
        pure [(u, v), (v, u)]
    let g = buildG (1, n) eds
        [t] = dfs g [1]
        pty = array (1, n) $ parity t
        (xs, ys) = partition (pty!) [1..n]
        zs = if length xs > length ys then xs ++ ys else ys ++ xs
        gs = concat $ sortOn (Down . length) $ groups n
        ans = array (1, n) $ zip zs gs
    putStrLn $ unwords $ map show $ elems ans

groups :: Int -> [[Int]]
groups 0 = []
groups n = [n, n-1 .. m] : groups (m - 1) where
    m = bit (highestSetBit n)

parity :: Tree a -> [(a, Bool)]
parity t = go False t [] where
    go p (Node u ts) acc = (u, p) : foldr (go $ not p) acc ts

highestSetBit :: Int -> Int
highestSetBit n = finiteBitSize n - countLeadingZeros n - 1

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

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


— Hey folks, how do you like this problem?— That'll do it. BThero is a powerful magician. He has got $$$n$$$ piles of candies, the $$$i$$$-th pile initially contains $$$a_i$$$ candies. BThero can cast a copy-paste spell as follows:   He chooses two piles $$$(i, j)$$$ such that $$$1 \le i, j \le n$$$ and $$$i \ne j$$$.  All candies from pile $$$i$$$ are copied into pile $$$j$$$. Formally, the operation $$$a_j := a_j + a_i$$$ is performed. BThero can cast this spell any number of times he wants to — but unfortunately, if some pile contains strictly more than $$$k$$$ candies, he loses his magic power. What is the maximum number of times BThero can cast the spell without losing his power?

The first line contains one integer $$$T$$$ ($$$1 \le T \le 500$$$) — the number of test cases. Each test case consists of two lines:    the first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 1000$$$, $$$2 \le k \le 10^4$$$);  the second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le k$$$).  It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$, and the sum of $$$k$$$ over all test cases does not exceed $$$10^4$$$.

For each test case, print one integer — the maximum number of times BThero can cast the spell without losing his magic power.

NoteIn the first test case we get either $$$a = [1, 2]$$$ or $$$a = [2, 1]$$$ after casting the spell for the first time, and it is impossible to cast it again.

import Control.Arrow ((>>>))

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

process :: [[Int]] -> [Int]
process [] = []
process ([n, k] : as : rest) = solve k as : process rest

solve :: Int -> [Int] -> Int
solve k a =
  (\a' -> sum a' - foldl1 max a') $
    map ((`div` (foldl1 min a)) . (k -)) a

import Control.Monad
import Data.List

solve :: Int -> [Int] -> Int
-- answer is at most 1000 * 10^4, so no overflow worries
solve k a = case  sort a  of
  [] -> 0
  (s : t) -> sum [div (k - x) s | x <- t]

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, k] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    print $ solve k a


Polycarpus has been working in the analytic department of the "F.R.A.U.D." company for as much as n days. Right now his task is to make a series of reports about the company's performance for the last n days. We know that the main information in a day report is value ai, the company's profit on the i-th day. If ai is negative, then the company suffered losses on the i-th day.Polycarpus should sort the daily reports into folders. Each folder should include data on the company's performance for several consecutive days. Of course, the information on each of the n days should be exactly in one folder. Thus, Polycarpus puts information on the first few days in the first folder. The information on the several following days goes to the second folder, and so on.It is known that the boss reads one daily report folder per day. If one folder has three or more reports for the days in which the company suffered losses (ai < 0), he loses his temper and his wrath is terrible.Therefore, Polycarpus wants to prepare the folders so that none of them contains information on three or more days with the loss, and the number of folders is minimal.Write a program that, given sequence ai, will print the minimum number of folders.

The first line contains integer n (1 ≤ n ≤ 100), n is the number of days. The second line contains a sequence of integers a1, a2, ..., an (|ai| ≤ 100), where ai means the company profit on the i-th day. It is possible that the company has no days with the negative ai.

Print an integer k — the required minimum number of folders. In the second line print a sequence of integers b1, b2, ..., bk, where bj is the number of day reports in the j-th folder. If there are multiple ways to sort the reports into k days, print any of them.

NoteHere goes a way to sort the reports from the first sample into three folders:  1 2 3 -4 -5 | -6 5 -5 | -6 -7 6 In the second sample you can put all five reports in one folder.

go [] = []
go [a] = [a]
go (a:b:c) = b:go c

main = do
  n <- fmap read getLine
  a <- fmap (map read . words) getLine
  let b = go $ map fst $ filter ((<0) . snd) $ zip [1 ..] a
      c = if null b then [n] else init b ++ [n]
  print $ length c
  putStrLn $ unwords $ map show $ zipWith (-) c $ 0:c

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-List.html

import Data.List

addOne :: [Int] -> [Int]
addOne (a:b) = (a + 1):b

getFolders :: Int -> [Int] -> [Int]
getFolders _ [] = 0:[]
getFolders 2 (a:b)
	| a >= 0	= addOne (getFolders 2 b)
	| otherwise	= 0:(addOne (getFolders 1 b))
getFolders n (a:b)
	| a >= 0	= addOne (getFolders n b)
	| otherwise	= addOne (getFolders (n + 1) b)

printList :: [Int] -> IO()
printList (a:[]) = do
	putStrLn (show a)
printList (a:b:c) = do
	putStr (show a)
	putStr " "
	printList (b:c)

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	let l = getFolders 0 (map read (words str2))
	putStrLn (show (length l))
	printList l

import Data.List

main = do
    getLine
    a <- fmap (map read . words) getLine
    let g = split a
    print $ length g
    putStr $ concat $ intersperse " " $ map (show . length) g

split xs = split' xs []
    where
        split' [] []       = []
        split' [] part     = [part]
        split' (x:xs) part = if x < 0 && (length $ filter (< 0) part) == 2
                                then part:(split' xs [x])
                                else split' xs (x:part)

import Control.Monad (liftM)
import Data.List (intercalate)

solve :: [Int] -> [Int]
solve  =  solve' 0 0
  where
    solve' _ 0 []  =  []
    solve' _ n []  =  [n]
    solve' a n (x:xs)
      | a == 2 && x < 0  =  n : solve' 0 0 (x:xs)
      | x < 0  =  solve' (a + 1) (n + 1) xs
      | otherwise  =  solve' a (n + 1) xs

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

main :: IO ()
main  =  do
    getLine
    xs  <-  liftM (map read . words) getLine
    prints $ solve xs

import Data.List
import Control.Applicative

readInt :: String -> Int
readInt = read

readSequence :: String -> [Int]
readSequence s = let (h,t) = break (==' ') s in
                 let t' = if null t then t else tail t in
                     if null h then [] else readInt h : readSequence t'

calc :: [Int] -> (Int,[Int])
calc = countFolders . folder . compress

compress :: [Int] -> [Bool]
compress = map (>=0)

folder :: [Bool] -> [[Bool]]
folder = reverse . f 0 [] []
  where f _ t r [] = t:r
        f x t r (b:bs) | b = f x (b:t) r bs
        f x t r (b:bs) | not b && x < 2 = f (x+1) (b:t) r bs
        f x t r (b:bs) | not b && x >= 2 = f 1 [b] (t:r) bs

countFolders :: [[a]] -> (Int, [Int])
countFolders xs = (length xs, map length xs)

main = do
  n <- readInt <$> getLine
  sequence <- readSequence <$> getLine
  let (k,bs) = calc sequence
  print k
  putStrLn $ tail $ concatMap ((' ':) . show) bs

{-# LANGUAGE BangPatterns #-}
main = do
  _ <- getLine
  xs <- fmap(map read.words)getLine
  let ans = solve 0 0 xs
  print $ length ans
  putStrLn.unwords.map show $ ans

solve !ans !cnt (x:rest)
  | x < 0 && cnt==2 = ans : solve 1 1 rest
  | x < 0 = solve (ans+1) (cnt+1) rest
  | otherwise = solve (ans+1) cnt rest
solve ans _ _ = [ans]

foo n [] = [n]
foo n [x] = [n]
foo n [_,x] = [n]
foo n (_:x:xs) = x : foo n xs

main = do
    line <- getLine
    let n = read line :: Int
    line <- getLine
    let a = map read $ words line :: [Int]
    let b = foo n $ map fst $ filter ((< 0) . snd) $ zip [1 ..] a
    let c = zipWith (-) b $ 0 : b
    putStrLn $ show $ length c
    putStrLn $ unwords $ map show c

import Data.List

main = do
    getLine
    a <- fmap (map read . words) getLine
    let g = split a
    print $ length g
    putStr $ concat $ intersperse " " $ map (show . length) g

split xs = split' xs []
    where
        split' [] []       = []
        split' [] part     = [part]
        split' (x:xs) part = if x < 0 && (length $ filter (< 0) part) == 3
                                then part:(split' xs [x])
                                else split' xs (x:part)


You are given a string $$$s$$$. You have to determine whether it is possible to build the string $$$s$$$ out of strings aa, aaa, bb and/or bbb by concatenating them. You can use the strings aa, aaa, bb and/or bbb any number of times and in any order.For example:  aaaabbb can be built as aa $$$+$$$ aa $$$+$$$ bbb;  bbaaaaabbb can be built as bb $$$+$$$ aaa $$$+$$$ aa $$$+$$$ bbb;  aaaaaa can be built as aa $$$+$$$ aa $$$+$$$ aa;  abab cannot be built from aa, aaa, bb and/or bbb.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case consists of one line containing the string $$$s$$$ ($$$1 \le |s| \le 50$$$), consisting of characters a and/or b.

For each test case, print YES if it is possible to build the string $$$s$$$. Otherwise, print NO. You may print each letter in any case (for example, YES, yes, Yes will all be recognized as positive answer, NO, no and nO will all be recognized as negative answer).

8

aaaabbb

bbaaaaabbb

aaaaaa

abab

a

b

aaaab

bbaaa

NoteThe first four test cases of the example are described in the statement.

--https://codeforces.com/contest/1671/problem/A

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

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInt :: IO Int
getInt = fmap read getLine

main :: IO ()
main = do
         n <- getInt
         input <- getLines n
         let a = map (\ e -> foldr (&&) True $ map (\ s -> length s > 1) $ group e) input
         let r = map (\x -> if x then "YES" else "NO") a
         putStr $ unlines r

--
{-# 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 :: String -> Bool
solve str = L.all (>= 2) groupLengths
    where
        groupLengths = L.length <$> L.group str

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> L.head . B8.words
        let answer = solve $ B8.unpack s
        putsYesNo answer

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = String
type OutType = Bool

solve :: InType -> OutType
solve (a : b : c : t) = (a == b || b == c) && solve (b : c : t)
solve _ = True

receive :: [String] -> InType
receive [s] = "*" ++ s ++ "*"
receive _   = error "input error"

main :: IO ()
main = interact $ unlines . map (showB . solve . receive) . chunksOf 1 . tail . lines
  where showB True  = "YES"
        showB False = "NO"

--https://codeforces.com/contest/1671/problem/A

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

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInt :: IO Int
getInt = fmap read getLine

check :: Int -> Bool
check i = mod i 2 == 0 || mod i 3 == 0 || mod i 4 == 0 || mod i 5 == 0 || mod i 6 == 0 || mod i 7 == 0

main :: IO ()
main = do
         n <- getInt
         input <- getLines n
         let a = map (\ e -> foldr (&&) True $ map (\ s -> check $ length s) $ group e) input
         let r = map (\x -> if x then "YES" else "NO") a
         putStr $ unlines r

--https://codeforces.com/contest/1671/problem/A

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

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getInts :: Int -> IO [Int]
getInts n = fmap read <$> getLines n

getInt :: IO Int
getInt = fmap read getLine

check :: Int -> Bool
check i = mod i 2 == 0 || mod i 3 == 0 || mod i 5 == 0

main :: IO ()
main = do
         n <- getInt
         input <- getLines n
         let a = map (\ e -> foldr (&&) True $ map (\ s -> check $ length s) $ group e) input
         let r = map (\x -> if x then "YES" else "NO") a
         putStr $ unlines r


You are given a string $$$s$$$, consisting only of characters '0' and '1'.You have to choose a contiguous substring of $$$s$$$ and remove all occurrences of the character, which is a strict minority in it, from the substring.That is, if the amount of '0's in the substring is strictly smaller than the amount of '1's, remove all occurrences of '0' from the substring. If the amount of '1's is strictly smaller than the amount of '0's, remove all occurrences of '1'. If the amounts are the same, do nothing.You have to apply the operation exactly once. What is the maximum amount of characters that can be removed?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. The only line of each testcase contains a non-empty string $$$s$$$, consisting only of characters '0' and '1'. The length of $$$s$$$ doesn't exceed $$$2 \cdot 10^5$$$. The total length of strings $$$s$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print a single integer — the maximum amount of characters that can be removed after applying the operation exactly once.

NoteIn the first testcase, you can choose substrings "0", "1" or "01". In "0" the amount of '0' is $$$1$$$, the amount of '1' is $$$0$$$. '1' is a strict minority, thus all occurrences of it are removed from the substring. However, since there were $$$0$$$ of them, nothing changes. Same for "1". And in "01" neither of '0' or '1' is a strict minority. Thus, nothing changes. So there is no way to remove any characters.In the second testcase, you can choose substring "10101010101". It contains $$$5$$$ characters '0' and $$$6$$$ characters '1'. '0' is a strict minority. Thus, you can remove all its occurrences. There exist other substrings that produce the same answer.In the third testcase, you can choose substring "011000100". It contains $$$6$$$ characters '0' and $$$3$$$ characters '1'. '1' is a strict minority. Thus, you can remove all its occurrences.

import Control.Monad (forM)

solve t = do
  input <- getLine
  let zero = foldl (\b x -> if x == '0' then b + 1 else b) 0 input
      one = foldl (\b x -> if x == '1' then b + 1 else b) 0 input
      mid = (length input - 1)`div` 2
  return $ minimum [zero, one, mid]

main = do
 tlen <- readLn :: IO Int
 ans <- forM [0..(tlen - 1)] (\t -> do
  solve t
  )
 mapM print ans

import Control.Monad (forM_)

count c = length . filter (== c)

solve l = (if c1 == c2 then (\x -> x - 1) else id) (min c1 c2)
  where
    c1 = count '1' l
    c2 = count '0' l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        print $ solve l

-- ID  : 1633B (B. Minority)
-- URL : https://codeforces.com/contest/1633/problem/B

import Control.Monad
import Data.Char

main = do
    t <- read `fmap` getLine :: IO Int
    replicateM_ t solve

solve = do
    -- input
    xs <- (map (\c -> ord c - ord '0')) `fmap` getLine
    let n = length xs
    let ones = foldl1 (+) xs
    let zeros = n - ones
    print $ ((n - 1) `div` 2) `min` zeros `min` ones

-- ID  : 1633B (B. Minority)
-- URL : https://codeforces.com/contest/1633/problem/B

import Control.Monad
import Data.Array
import Data.Char
import Data.Int

getInt = read `fmap` getLine :: IO Int

main = do
    t <- getInt
    replicateM_ (fromIntegral t) solve

parse01 c
    | c == '0' = 0
    | c == '1' = 1

solve = do
    -- input
    xs <- (map parse01) `fmap` getLine
    let n = length xs
    let ones = listArray (0,n) $ scanl (+) 0 xs
    let f1 i = (ones ! i)
    let f0 i = (fromIntegral i) - (f1 i)
    -- solve
    let dp = array (1,n) [(i, f i) | i <- [1..n]] where
        f 1 = 0
        f 2 = 0
        f i = max (dp ! (i-1)) (if (f1 i) == (f0 i) then 0 else (min (f1 i) (f0 i)))
    print (dp ! n)

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        s <- getLine
        let _0 = count '0' s
            _1 = count '1' s
        print $ (if _0 == _1 then subtract 1 else id) (min _0 _1)

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

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>= print . minRem

minRem s = let (ones, zeroes) = countE s (0, 0) in
             if (ones == zeroes)
             then ones-1
             else min ones zeroes

countE :: String -> (Int, Int) -> (Int, Int)
countE [] a = a
countE ('0':xs) (o, z) = countE xs (o, z+1)
countE ('1':xs) (o, z) = countE xs (o+1, z)

import Control.Monad (forM_)

solve (s:ss) o z =
    if o == z then
        if s == '1' then solve ss (o-1) z else solve ss o (z-1)
        else min o z

main = do
    n <- readLn :: IO Int
    forM_ [1..n] $ \_ -> do
        s <- getLine
        let ones = length $ filter (=='1') s
        let zeros = (length s) - ones
        print $ max (solve s ones zeros) (solve (reverse s) ones zeros)

import Control.Monad

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        str <- getLine
        print $ solve str
    return ()

solve :: String -> Int
solve str = if zeroes == ones
               then ones - 1
               else min zeroes ones
    where
        zeroes = count '0' str
        ones = count '1' str

count :: Char -> String -> Int
count x = length . filter (x==)

main :: IO()

main =
    interact $ unlines . map (show . process) . drop 1 . lines

process xs =
    let s1 = foldl (\acc x -> if x == '1' then acc+1 else acc) 0 xs
        s0 = length xs - s1
    in if s0 == s1 then s0 - 1 else min s0 s1

import Control.Monad (forM)

solve t = do
  input <- getLine
  let zero = foldl (\b x -> if x == '0' then b + 1 else b) 0 input
      one = foldl (\b x -> if x == '1' then b + 1 else b) 0 input
      mid = length input `div` 2 - 1
  return $ minimum [zero, one, mid]

main = do
 tlen <- readLn :: IO Int
 ans <- forM [0..(tlen - 1)] (\t -> do
  solve t
  )
 mapM print ans

import Control.Monad (forM)

solve t = do
  input <- getLine
  let zero = foldl (\b x -> if x == '0' then b + 1 else b) 0 input
      one = foldl (\b x -> if x == '1' then b + 1 else b) 0 input
  return (if zero > one then one else if one > zero then zero else 0)

main = do
 tlen <- readLn :: IO Int
 ans <- forM [0..(tlen - 1)] (\t -> do
  solve t
  )
 mapM print ans

import Control.Monad (forM_)

count c = length . filter (== c)

solvee c1 c2
    | c1 < c2 = c1
    | c1 == c2 = 0
    | otherwise = c2

solve l = solvee c1 c2
  where
    c1 = count '1' l
    c2 = count '0' l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        print $ solve l

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        s <- getLine
        let _0 = count '0' s
            _1 = count '1' s
        print $ if _0 == _1 then 0 else min _0 _1

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


You are given an array $$$a$$$ of size $$$n$$$. Each element in this array is an integer between $$$1$$$ and $$$10^9$$$.You can perform several operations to this array. During an operation, you can replace an element in the array with any integer between $$$1$$$ and $$$10^9$$$. Output the minimum number of operations needed such that the resulting array doesn't contain any local maximums, and the resulting array after the operations.An element $$$a_i$$$ is a local maximum if it is strictly larger than both of its neighbors (that is, $$$a_i > a_{i - 1}$$$ and $$$a_i > a_{i + 1}$$$). Since $$$a_1$$$ and $$$a_n$$$ have only one neighbor each, they will never be a local maximum.

Each test contains multiple test cases. The first line will contain a single integer $$$t$$$ $$$(1 \leq t \leq 10000)$$$ — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ $$$(2 \leq n \leq 2 \cdot 10^5)$$$ — the size of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots ,a_n$$$ $$$(1 \leq a_i \leq 10^9)$$$, the elements of array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, first output a line containing a single integer $$$m$$$ — minimum number of operations required. Then ouput a line consist of $$$n$$$ integers — the resulting array after the operations. Note that this array should differ in exactly $$$m$$$ elements from the initial array. If there are multiple answers, print any.

NoteIn the first example, the array contains no local maximum, so we don't need to perform operations.In the second example, we can change $$$a_2$$$ to $$$3$$$, then the array don't have local maximums.

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

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

solve :: [Int] -> [Int]
solve [] = []
solve (p : q : r : vs)
  | q > p && q > r  = p : q : maximum (q : take 1 vs) : solve vs
solve (v : vs) = v : solve vs

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve a
      diffs = length $ filter id $ zipWith (/=) a ans
    pure $ putInts [diffs] <> putInts ans

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

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

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

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

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

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

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

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

solve :: [Int] -> [Maybe Int]
solve [] = []
solve (p : q : r : vs)
  | q > p && q > r  = Just p : Just q : Nothing : solve vs
solve (v : vs) = Just v : solve vs

solve2 :: [Maybe Int] -> [Int]
solve2 [Just x, Nothing] = [x, x]
solve2 (Just x : Nothing : t@(Just y : _)) = x : max x y : solve2 t
solve2 (Nothing : t@(Just y : _)) = y : solve2 t
solve2 (Just x : t) = x : solve2 t
solve2 [] = []
solve2 (Nothing : _) = error "solve2: yikes"

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve a
      diffs = length $ filter isNothing ans
    pure $ putInts [diffs] <> putInts (solve2 ans)

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

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

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

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

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

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

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

solve :: (Ord t, Num a) => t -> t -> [t] -> a
solve _ _ [] = 0
solve ll l (c : []) = if (l > ll && l > c) then 1 else 0
solve ll l (c : cs)
  | l > ll && l > c = 1 + solve l (max l (cs !! 0)) cs
  | otherwise = solve l c cs

solve2 :: (Ord t, Num t) => t -> t -> [t] -> [t]
solve2 a b [] = [a,b]
solve2 ll l (c : []) = if (l > ll && l > c) then [ll,l, l] else [ll, l, c]
solve2 ll l (c : cs)
  | l > ll && l > c = (ll : solve2 l (max l (cs !! 0)) cs)
  | otherwise = (ll : (solve2 l c cs))

main :: IO ()
main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \i -> do
    n <- readLn :: IO Int
    l <- getLine
    let arr = map read (words l) :: [Int]
    let (a : b : cs) = arr
    let a1 = solve a b cs
    print a1
    let a2 = solve2 a b cs
    forM_ a2 $ \i -> do
      putStr $ show(i)
      putStr " "
    putStr "\n"

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

solve :: (Num b, Ord b) => [b] -> b -> ([b], b)
solve [] ops = ([], ops)
solve [a] ops = ([a], ops)
solve [a, b] ops = ([a, b], ops)
solve (a : b : c : cs) ops = (a : next, ops')
  where
    maxx = b > a && b > c
    maxxx = max b (if not (null cs) then head cs else 0)
    (next, ops') = solve (if maxx then b : maxxx : cs else b : c : cs) (if maxx then ops + 1 else ops)

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

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

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

solve :: Int -> [Int] -> [Int]
solve _ [] = []
solve repv (p : q : r : vs)
  | q > p && q > r  = p : q : solve repv (repv : vs)
solve repv (v : vs) = v : solve repv vs

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve (foldl' max minBound a) a
      diffs = length $ filter id $ zipWith (/=) a ans
    pure $ putInts [diffs] <> putInts ans

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

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

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

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

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

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