import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else v:acc
                              else if v `elem` acc then acc else v:init acc

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> a ++ ' ' : show v) (show $ head l) (tail l)

import Data.Set (Set)
import qualified Data.Set as Set

inputArr = do
  line <- getLine
  let ar = map read (words line) :: [Int]
  return ar

sim cur cur2 st [] rem = cur ++ (reverse cur2)
sim [] [] st (x:xs) rem = sim [] [x] (Set.insert x st) xs (rem-1)
sim (c:cs) [] st xs rem = sim [] (reverse (c:cs)) st xs rem
sim cur (c:cs) st (x:xs) rem
  | Set.member x st = sim cur (c:cs) st xs rem
  | rem > 0 = sim (x:cur) (c:cs) (Set.insert x st) xs (rem-1)
  | otherwise = sim (x:cur) cs newSt xs rem
      where newSt = Set.insert x (Set.delete c st)

main = do
  [n,k] <- inputArr
  a <- inputArr
  let res = sim [] [] Set.empty a k
  putStrLn (show (length res))
  putStrLn (concat (map ((++ " ") . show) res))

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  ids <- map read . words <$> getLine :: IO [Int]
  let ids' = foldl' (incoming k) [] ids
  print (length ids')
  putStrLn $ unwords $ map show ids'
incoming k q i | i `elem` q = q
               | otherwise = take k (i : q)

import Data.Foldable
import Data.Set hiding (map, deleteAt, toList)
import Data.Sequence
import Control.Monad

solve :: Int -> Int -> [Int] -> (Int, [Int])
solve n k ids =
	let
		helper :: Set Int -> Seq Int -> Int -> [Int] -> (Int, [Int])
		helper set seq m [] = (m, toList seq)
		helper set seq m (id:ids)
			| id `member` set = helper set seq m ids
			| otherwise =
			if m < k
			then helper (id `insert` set) (id <| seq) (m + 1) ids
			else let
				Just toDel = seq !? (k - 1)
			in
				helper (id `insert` (toDel `delete` set)) (id <| (deleteAt (k - 1) seq)) m ids
	in
		helper Data.Set.empty Data.Sequence.empty 0 ids
main = do
	firstStr <- getLine
	let n : k : [] = map read $ words firstStr
	secondStr <- getLine
	let ids = map read $ words secondStr
	let (m, finalIds) = solve n k ids
	putStrLn $ show m
	mapM_ (\x -> putStr $ (show x) ++ " ") finalIds

import Data.List
import qualified Data.Sequence as Q
import qualified Data.IntSet as S
import Data.Foldable
main = do
  [n,k] <- map read . words <$> getLine
  ids <- map read . words <$> getLine :: IO [Int]
  let (ids',_) = foldl' (incoming k) (Q.empty,S.empty) ids
  print (length ids')
  putStrLn $ unwords $ map show $ toList ids'
incoming k (q,s) i | i `S.member` s = (q,s)
                   | Q.length q < k = (i Q.<| q,S.insert i s)
                   | (q' Q.:> i') <- Q.viewr q =
                       (i Q.<| q',S.insert i (S.delete i' s))

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else v:acc
                              else if v `elem` acc then acc else v:(tail acc)

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> a ++ ' ' : (show v)) (show $ head l) (tail l)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else acc ++ [v]
                              else if v `elem` acc then acc else init acc ++ [v]

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> show v ++ ' ' : a) (show $ head l) (tail l)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else acc ++ [v]
                              else if v `elem` acc then acc else v:init acc

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> show v ++ ' ' : a) (show $ head l) (tail l)


{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $! solve

solve :: String -> String
solve s = check (map words (tail (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre
      | max w h <= pre = check xs (max w h)
      | min w h <= pre = check xs (min w h)
      | otherwise = "NO"
    where
        [ws, hs] = x
        w = read ws :: Int
        h = read hs :: Int

import Data.List

toint s = (read s) :: Integer

doit [] k = True
doit (x:(y:xs)) k =
    if max x y <= k then
        doit xs $ max x y
    else
        if min x y <= k then
            doit xs $ min x y
        else
            False

solve::String -> String
solve ss =
    let s = map toint (tail (words ss)) in
    let r = doit s (2^30) in
    if r then
        "YES\n"
    else
        "NO\n"

main = do
  interact $ solve

import Data.Maybe

main = interact foo

foo :: String -> String
foo inp =
    let _:(n1, n2):ns = map (\n -> (n!!0, n!!1)) . map (map read . words) . lines $ inp :: [(Int, Int)]
    in if isNothing $ foldl check (Just $ max n1 n2) ns then "NO" else "YES"

check :: Maybe Int -> (Int, Int) -> Maybe Int
check Nothing _ = Nothing
check (Just l) (n1, n2)
    | l >= man = Just man
    | l >= mn = Just mn
    | otherwise = Nothing
        where mn = min n1 n2
              man = max n1 n2

module Main where

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

pr :: String -> (Int, Int)
pr str = (read f :: Int, read s :: Int)
  where
    [f, s] = words str

f :: (Int, Bool) -> (Int, Int) -> (Int, Bool)
f (lv, r) (cw, ch)
  | not r = (lv, r)
  | max cw ch <= lv = (max cw ch, r)
  | min cw ch <= lv = (min cw ch, r)
  | otherwise = (lv, False)

solve :: String -> String
solve s
  | ans = "YES"
  | not ans = "NO"
  where
    r = map pr (tail (lines s))
    (_, ans) = foldl f (maxBound :: Int, True) r

main = interact $! solve

{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $! solve

toInt :: String -> Int
toInt s = read s :: Int

solve :: String -> String
solve s = check (tail (map words (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre =
    if | max w h <= pre -> check xs (max w h)
       | min w h <= pre -> check xs (min w h)
       | otherwise -> "NO"
    where
        [ws, hs] = x
        w = toInt ws
        h = toInt hs

{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $ solve

toInt :: String -> Int
toInt s = read s :: Int

solve :: String -> String
solve s = check (tail (map words (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre =
    if | max w h <= pre -> check xs (max w h)
       | min w h <= pre -> check xs (min w h)
       | otherwise -> "NO"
    where
        [ws, hs] = x
        w = toInt ws
        h = toInt hs


import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex; arr2 = if even p then [1,2] else [2,1]
                in take p (cycle [2,1]) ++ take (n-p) (cycle arr2)
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex :: [Int]
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 (xs++[head xs])) [1..]

{-# LANGUAGE Safe #-}

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

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

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[maximum fin], fin]
  where
    nn = fromIntegral n
    fin
      | all (== head a) a = replicate nn 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Integer] -> Maybe [Integer]
    update [] = Nothing
    update [_] = Nothing
    update (x : x' : xs)
      | x == x' = Just (x : map (pick True) (x' : xs))
      | otherwise = (x :) <$> update (x' : xs)

    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Integer -> Integer
    pick fl x = bool x (3 - x) fl

{-# LANGUAGE Safe #-}

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

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

process :: [[Int]] -> [[Int]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Int -> [Int] -> [[Int]]
solve n a = [[maximum fin], fin]
  where
    fin
      | all (== head a) a = replicate n 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Int] -> Maybe [Int]
    update [] = Nothing
    update [_] = Nothing
    update (x : xs)
      | x == head xs = Just (x : map (pick True) xs)
      | otherwise = (x :) <$> update xs

    colour :: Int -> [Int] -> [Int]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Int -> Int
    pick fl x = bool x (3 - x) fl

{-# LANGUAGE Safe #-}

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

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

process :: [[Int]] -> [[Int]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Int -> [Int] -> [[Int]]
solve n a = [[maximum fin], fin]
  where
    nn = fromIntegral n
    fin
      | all (== head a) a = replicate nn 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Int] -> Maybe [Int]
    update [] = Nothing
    update [_] = Nothing
    update (x : x' : xs)
      | x == x' = Just (x : map (pick True) (x' : xs))
      | otherwise = (x :) <$> update (x' : xs)

    colour :: Int -> [Int] -> [Int]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Int -> Int
    pick fl x = bool x (3 - x) fl

import Control.Monad (replicateM_)
import Data.List (nub)

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        n <- read <$> getLine
        ts <- words <$> getLine
        if same ts then do
            print 1
            putStrLn $ unwords $ replicate n "1"
        else if n `mod` 2 == 0 then do
            print 2
            putStrLn $ unwords $ concat $ replicate (div n 2) ["1", "2"]
        else case consec 0 (head ts) ts of
            Just i -> do
                print 2
                putStrLn $ unwords $ repeatNth i $ concat $
                    replicate (div n 2) ["1", "2"]
            Nothing -> do
                print 3
                putStrLn $ unwords $ ("3" :) $ concat $
                    replicate (div n 2) ["1", "2"]

same (x:xs@(y:_)) = x == y && same xs
same _ = True

consec _ _ [] = Nothing
consec i x [y] = if x == y then Just i else Nothing
consec i s (x:y:zs) = if x == y then Just i else consec (i + 1) s (y:zs)

repeatNth n (x:xs) =
    if n == length xs + 1
    then (x:xs) ++ [x]
    else repeatNth' n (x:xs)

repeatNth' 0 (x:xs) = x:x:xs
repeatNth' n (x:xs) = x : repeatNth' (n-1) xs

import Control.Arrow

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

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n]:a:rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[foldl1 max fin], fin]
  where
    nn = fromIntegral n
    fin
      | a == (take nn $ repeat (head a)) = take nn $ repeat 1
      | head cols == head (reverse cols)
          && head a /= head (reverse a) =
            case newcols of Nothing -> 3 : tail cols
                            (Just a) -> a
      | otherwise = cols
          where newcols = update cols

    cols = colour 1 a

    update :: [Integer] -> Maybe [Integer]
    update [] = Nothing
    update [_] = Nothing
    update (x:y:rest)
      | x == y = Just (x : map (pick True) (y : rest))
      | otherwise = case rec of (Just a) -> Just (x : a)
                                Nothing -> Nothing
        where rec = update (y : rest)

    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [x] = [cur]
    colour cur (x:y:rest) = cur : colour (pick (x /= y) cur) (y : rest)

    pick :: Bool -> Integer -> Integer
    pick fl x
      | fl = 3 - x
      | otherwise = x

import Control.Arrow

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

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n]:a:rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[foldl1 max fin], fin]
  where
    fin
      | head cols == head (reverse cols)
          && head a /= head (reverse a) = 3 : tail cols
      | otherwise = cols
    cols = colour 1 a
    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [x] = [cur]
    colour cur (x:y:rest)
      | x == y = cur : colour cur (y : rest)
      | otherwise = cur : colour (3 - cur) (y : rest)

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex; arr2 = if even p then [1,2] else [2,1]
                in take p (cycle [2,1]) ++ take (n-p) (cycle arr2)
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex :: [Int]
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 xs) [1..]

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex in take p (cycle [2,1]) ++ take (n-p) (cycle [1,2])
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 xs) [1..]


{-# 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       = 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

{-# 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


{-# 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)

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 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 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)

{-# 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)


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 [[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

{-# 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


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

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


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

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]

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)


--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


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 (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

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)