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)


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


import Data.List(sort)
getans m k (mx:smx:_) = mx*m - (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Integer) . words  <$> getLine
    n <- map (read :: String -> Integer) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Int) . words  <$> getLine
    n <- map (read :: String -> Int) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

import Data.List
import Data.Maybe

main = do
  getLine
  [x, k, y] <- map read . words <$> getLine
  as <- (0 :) . (++ [-1]) . map read . words <$> getLine
  bs <- (0 :) . (++ [-1]) . map read . words <$> getLine
  print $ fromMaybe (- 1) $ solve x k y as bs

solve x k y (al : ars) (bl : bs@(br : _))
  | al /= bl || null as || null costs = Nothing
  | otherwise = (minimum costs +) <$> solve x k y as bs
  where
    (range, as) = span (/= br) ars
    len = genericLength range
    costs = [y * len | maximum (0 : range) < max bl br] ++ concat [[x + y * (len - k), x * (len `div` k) + y * (len `mod` k)] | len >= k]
solve _ _ _ _ _ = Just 0


module Main where

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

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

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

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

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

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

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

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    [h, w] <- getIntList
    let ans = getAnswer h w 1
    forM_ ans putStrLn
    putChar '\n'

getFirstAndLast :: Int -> String
getFirstAndLast w = take w $ cycle "10"

getAnswer :: Int -> Int -> Int -> [String]
getAnswer h w i
    | i == h         = [getFirstAndLast w]
    | i == 1         = getFirstAndLast w : getAnswer h w (i + 1)
    | i == h - 1     = emptyLine : getAnswer h w (i + 1)
    | i `mod` 2 == 0 = emptyLine : getAnswer h w (i + 1)
    | otherwise      = setLine : getAnswer h w (i + 1)
    where emptyLine = take w $ repeat '0'
          setLine   = "1" ++ (take (w - 2) $ repeat '0') ++ "1"

-- 101001
-- 000000
-- 100001
-- 000000
-- 100000
-- 001010

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

llines :: Int -> Int -> Int -> [String]
llines h w curr
  | curr == 0 = line : llines h w (curr+1)
  | curr == h - 1 = [line]
  | otherwise = (if odd curr || curr == h - 2 then replicate w '0' else "1" ++ replicate (w-2) '0' ++ "1") : llines h w (curr+1)
    where evenline = foldl (++) "" $ replicate (div w 2) "10"
          oddline = evenline ++ "1"
          line = if even w then evenline else oddline

solve :: IO ()
solve = do
  s <- getLine
  let [h, w] = map read $ words s :: [Int]
      rect = llines h w 0
    in putStrLn $ intercalate "\n" rect

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

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

main :: IO ()
-- main = C.interact $ runScanner (C.pack <$> testCase)
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = unlines . solve <$> pair int int

type Grid = [[Char]]

solve :: (Int, Int) -> Grid
solve (h, w) = [[if ok i j then '1' else '0' | j <- [1 .. w]] | i <- [1 .. h]]
  where
    ok i j
      | i == 1 = odd j
      | i == h = odd j && h >= 3
      | otherwise = odd i && i + 2 <= h && (j == 1 || j == w)

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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


{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

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

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "14689") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Data.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

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

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) twoDigits of
                       y : _ -> show y
                       []    -> error "oops"
  where
    twoDigits = map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s

module Main where

import Data.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

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

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) (map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)) of
                       y : _ -> show y
                       []    -> error "oops"

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s
      -- showAns s = unlines [show (length s), s]

import Control.Monad
import Data.List
import Data.Maybe (fromJust)

isEvenChar '1' = True
isEvenChar '4' = True
isEvenChar '6' = True
isEvenChar '8' = True
isEvenChar '9' = True
isEvenChar _ = False

calc1 :: String -> Maybe String
calc1 x = do
  letter <- find isEvenChar x
  return $ [letter]

calc2 :: String -> Maybe String
calc2 (a:'2':xs) = Just (a:['2'])
calc2 (a:'5':xs) = Just (a:['5'])
calc2 (a:b:xs) | a == b = Just (a:[b])
calc2 (a:b:c:xs) | a == c = Just (a:[c])
calc2 ('2':'3':'7':xs) = Just ('2':['7'])
calc2 ('2':'7':xs) = Just ('2':['7'])
calc2 ('5':'3':'7':xs) = Just ('5':['7'])
calc2 ('5':'7':xs) = Just ('5':['7'])
calc2 (a:b:c:xs) = calc2 (b:c:xs)
calc2 _ | otherwise = Nothing

(<||>) :: (Monoid a, Eq a) => a -> a -> a
x <||> y
     | x == mempty = y
     | True = x

-- 77, 33
calc3 :: Char -> String -> Maybe String
calc3 ch x =
  let count = foldr (\a b -> if a == ch then (b+1) else b) 0 x in
    if count >= 2 then Just (ch:[ch])
    else Nothing

calc :: String -> Maybe String
calc a = (calc1 a) <||> (calc2 a ) <||> (calc3 '7' a) <||> (calc3 '3' a)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let k = read line :: Int
    line <- getLine
    let ans1 = calc line
    --print line
    let ans = fromJust ans1
    print $ length ans
    putStrLn ans

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

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

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "1468") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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


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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
    print $ if s >= n then s - n else 1

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

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            sm = sum a
            n = read ns :: Int
        print $
            if sm < n then
                1
            else
                sm - n

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

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    s <- sum <$> getInts
    if s < k then
      print 1
    else
      print $ s - k

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    a <- getInts
    let s = sum a
    if s < k then
      print 1
    else
      print $ s - k

module Main where

(|>) = flip ($)

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

solve :: [Int] -> Int
solve a =
    if sum a >= length a
       then (sum a) - (length a)
       else 1

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

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]
printS = do
    n <- readLn::IO Int
    aa <- readInts
    let s = sum aa
    print $ if s>=n then s-n else 1
main = do
    t <- readLn::IO Int
    replicateM_ t printS

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [k] <- getInts
    s <- sum <$> getInts
    let
      result = case compare s k of
        GT -> s - k
        LT -> 1
        EQ -> 0
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        a <- map parseInt . BS.words <$> BS.getLine
        let s = sum a
        if n == s then
            putStrLn "0"
        else if n > s then
            putStrLn "1"
        else
            print $ s - n

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) (words s)
            n = read ns :: Integer
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

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

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

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) (words s)
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

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

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

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

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else 1

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

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else l + 1

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

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    print $ abs (sum a) - length a

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


luckyDigits :: String -> Int
luckyDigits xs = length $ filter (\x -> x == '4' || x == '7') xs

solve :: Int -> [String] -> Int
solve k xs = length $ filter (\x -> luckyDigits x <= k) xs

parseInput :: String -> (Int, [String])
parseInput input = (k, xs) where
    ls = lines input
    k = read $ last $ words $ head ls
    xs = words $ last ls

main = do
    input <- getContents
    let (k, xs) = parseInput input
    print $ solve k xs

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- words <$> getLine
	let
		res = length $ filter ( ok k ) as
	print res

ok :: Int -> String -> Bool
ok k a = count47 a <= k
	where
		count47 :: String -> Int
		count47 = length . filter ( \c -> c == '4' || c == '7' )

main = interact $ show . solve . words

solve (n : kk : a) = length . filter ((<=k) . length . filter (`elem` "47")) $ a
                    where k = read kk

import Data.List

lucky x = x == '4' || x == '7'

findLucky k [] = 0
findLucky k (a:ais) =
    let l = length $ (findIndices lucky a)
    in if l > k then findLucky k ais else 1 + findLucky k ais

main :: IO ()
main = do
    nm <- getLine
    let [_, k] = map read $ words nm
    ais <- getLine
    let a = words ais
    print $ findLucky k a

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

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

solve :: Int -> [String] -> Int
solve k  =  length . filter happyDigitsLessK
  where
    happyDigitsLessK  =  (<= k) . length . filter isHappyDigit
    isHappyDigit c  =  c == '4' || c == '7'

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs  <-  liftM words getLine
    print $ solve k xs

import Prelude

main = do
	str <- getContents
	print $ solve str

solve :: String -> Int
solve str = length $ filter (<=k) $ ln
	where
		(ns:ks:a) = words str
		n = read ns
		k =  read ks
		aa = take n a
		ln = map toLucky aa
		toLucky number = length $ filter (\chr -> (chr == '7') || (chr == '4')) $ number

g s c = length $ filter (==c) s
f s = sum $ map (g s) "47"
t (k:s) = length $ filter (<=read k) $ map f s
main = interact $ show . t . tail . words

main :: IO ()
main = do
  nkLine <- getLine
  intLine <- getLine
  let
    k = read $ last $ words nkLine
    intVals = words intLine
    lengths = map length $ map (filter (\x -> x == '4' || x == '7')) intVals
    numLuckies = length $ filter (<= k) lengths
    in
   print numLuckies

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

solve :: [Int] -> Int
solve (k:as) = length [ () | a <- as, length (filter (`elem`"47") (show a)) <= k ]
solve _ = undefined

main = interact $ show . solve . tail . words
solve (k:as) = length $ filter ((<= read k) . length . filter (`elem` "47")) as

main=interact$show.f.words
f(_:k:x)=l[y|y<-x,l(filter(`elem`"47")y)<=read k]
l=length

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show . length . filter (<=k) . map f $ words a
  where
    f = length . filter (\x -> x=='4' || x=='7')
    k = read . head . tail . words $ m

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let [_, k] = map read $ words nkStr
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if checkHappyDigits num k then a+1 else a) 0 nums

module Main where
import Data.Char
import Data.List.Split

strToInt :: String -> Int
strToInt = helper 0
	where
		helper acc [] = acc
		helper acc (x:xs) = helper (acc * 10 - 48 + ord x) xs

fits :: Int -> String -> Int
fits k s = helper s 0
	where
		helper [] acc | acc > k = 0
			      | otherwise = 1
		helper (x:xs) acc | x == '4' || x == '7' = helper xs (acc + 1)
				  | otherwise = helper xs acc

toInts :: String -> [Int]
toInts = map strToInt . filter (/="") . splitOn " "

process :: String -> String -> String
process par = show . sum . map (fits k) . splitOn " "
	where
		(n:k:xs) = toInts par

main :: IO ()
main = do
	n <- getLine
	s <- getLine
	putStrLn $ process n s

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         n = nk!!0
         k = nk!!1
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if (checkHappyDigits num k) then (a+1) else a) 0 nums

import Control.Applicative
import Data.List

main= do
	[n,k]<- map read . words<$> getLine ::IO [Int]
	s<- words <$> getLine
	print $ length $ filter (<=k) $ map (length. filter (\z-> elem z "47") ) s

process :: Int -> [String] -> Int
process k = length . filter f
    where f = (<=k) . length . filter (\x -> x `elem` "47")

readInt :: String -> Int
readInt = read

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

main = do
    [n, k] <- fmap (map read . words) getLine :: IO [Int]
    a <- fmap words getLine :: IO [String]
    print $ length $ filter (<= k) $ map f a where
        f [] = 0
        f (x:xs)
            | x == '4' || x == '7' = 1 + f xs
            | otherwise            = f xs

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.IntMap as IntMap
import Data.List

solve k num =
  (lucky num) > k
  where lucky n = length $ filter (\d -> (d == 4) || (d == 7)) $ map (`mod` 10)
                   $ takeWhile (> 0) $ iterate (`div`10) n
main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let Just (k, r2) = readInt r1
     let Just (numbers, r3) = readIntList n r2
     let tSeq = length $ filter (\x -> x == False) $ map (solve k) numbers
     putStr $ show tSeq ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (number, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return ((number : l, t))

import Control.Applicative
main = do
    [n,k] <- map read . words <$> getLine
    ns <- take n . words <$> getContents
    let
        ans = length $ filter (<=k) $ map toNumberOfLucky $ ns
        toNumberOfLucky word = length $ filter (\c -> c=='4'||c=='7') $ word
    print ans

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: Int -> [String] -> Int
solve k = length . filter (ok k)

ok :: Int -> String -> Bool
ok k = (<= k). length . filter (`elem` "47")

-- Shit
main :: IO ()
main = do
        [[_,k], as]  <- readShit
        printShit $ solve (read k) as

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: x -> x -> Bool-> x
iif a b c = if c then a else b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit String where
    printShit = putStrLn
    printShitV = putStrLn
    readShit = getLine

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

main=interact$show.f.map read.words
f(n:k:x)=l[y|y<-x,l(show y)<=k]
l=length


main :: IO ()
main = interact $ unlines . map unwords . solve . words

solve :: [String] -> [[String]]
solve (_ : ds) = [[show $ length ans], ans]
  where
  ans
    | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
    | otherwise = d0 ++ d1 ++ d2 ++ d3
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (\x->0<x&&x<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

takeFirst :: [String] -> [String]
takeFirst [] = []
takeFirst (x : xs) = [x]

transTo01 :: String -> String
transTo01 [] = []
transTo01 (x : xs) = (if x == '0' then '0' else '1') : (transTo01 xs)

handle :: [String] -> [[String]]
handle (_ : xs) = [[show $ length res], res]
    where
    res
        | null $ x1 ++ x10 = x0 ++ x11 ++ x100
        | otherwise        = x0 ++ x1 ++ x10 ++ x100
    x0   = take 1 [x | x <- xs, transTo01 x == "0"  ]
    x1   = take 1 [x | x <- xs, transTo01 x == "1"  ]
    x10  = take 1 [x | x <- xs, transTo01 x == "10" ]
    x11  = take 1 [x | x <- xs, transTo01 x == "11" ]
    x100 = take 1 [x | x <- xs, transTo01 x == "100"]

main :: IO ()
main = interact $ unlines . map unwords . handle . words

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

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

solve :: [Int] -> [Int]
solve as
    | null maybe1_9 && null maybe10_90  =  concat [maybe0, maybe1_99, maybe100]
    | otherwise  =  concat [maybe0, maybe1_9, maybe10_90, maybe100]
  where
    maybe0  =  take 1 $ filter (==0) as
    maybe100  =  take 1 $ filter (== 100) as
    maybe1_9  =  take 1 $ filter (\x -> 1 <= x && x <= 9) as
    maybe10_90  =  take 1 $ filter ((== 0) . flip mod 10) $ filter (\x -> 1 <= x && x <= 99) as
    maybe1_99  =  take 1 $ filter (/= 0) $ filter (/= 100) as

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

main :: IO ()
main  =  getLine >> reads >>= prints . solve

main :: IO ()
main = interact $ unwords . solve . words

solve :: [String] -> [String]
solve (_ : ds)
  | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
  | otherwise = d0 ++ d1 ++ d2 ++ d3
  where
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null zs = [[length ys],ys]
  | otherwise = [[1+length ys],(zs!!0):ys]
   where
     ys = filter(elem '0'.show) xs
     zs = filter(notElem '0'.show) xs