import Control.Monad

isGood :: Int -> Bool
isGood x = ((rem x 3) /= 0) && ((last $ show x) /= '3')

solve k = (filter isGood (iterate(+1) 1)) !! (k - 1)

-- main :: IO ()
main = do
  t <- readLn :: IO Int
  inputs <- replicateM (t) (readLn :: IO Int)

  let answers = map solve inputs

  mapM_ putStrLn (map show answers)

main=interact$unlines.map(show.(!!)[x+3|x<-[-4..],mod x 3*mod x 10/=0].read).tail.lines

import Control.Monad

isPolycarpInteger :: Integer -> Bool
isPolycarpInteger x = (x `mod` 3 /= 0) && (x `mod` 10 /= 3)

getPolycarpIntegerByIndex :: Integer -> Integer
getPolycarpIntegerByIndex index = polycarp_sequence !! (fromIntegral index)
    where polycarp_sequence = filter isPolycarpInteger [1..]

main :: IO()
main = do
    tests_n_input <- getLine
    tests_inputs <- replicateM (read tests_n_input) getLine
    let required_indices = map (\x -> (read x) - 1) tests_inputs
    let results = map getPolycarpIntegerByIndex required_indices
    mapM_ print results

--ghc 8.6.3

readLnInt :: IO (Int)
readLnInt = do
  input <- getLine
  return (read input)

getLns' :: Int -> IO([String])
getLns' n
  | n == 0 = return []
  | otherwise = do
    ln <- getLine
    lns <- getLns' (n - 1)
    return (ln:lns)

getLns :: Read a => Int -> IO([a])
getLns n = fmap (fmap read) $ getLns' n

ans = [x | x <- [1..],
           mod x 3 /= 0,
           mod x 10 /= 3]

main = do
  n <- readLnInt
  qs <- getLns n
  mapM_ print $ map (ans !!) (map (subtract 1) qs)

kthNum 1 i = do
    print(i)

kthNum k i = do
    let newI = i+1
    let newK = if (newI `mod` 3 /= 0) && (newI `mod` 10 /= 3) then k-1 else k
    kthNum newK newI

doTask 0 = return ()

doTask t = do
    input <- getLine
    let k = read input :: Int
    kthNum k 1
    doTask (t-1)

main :: IO ()
main =  do
    input <- getLine
    let t = read input :: Int
    doTask t

import Control.Monad
import Data.List

calc :: Int -> Int
calc k =
  (filter (\x ->
            (x `mod` 3 /= 0) && (x `mod` 10 /= 3)
            ) [1..]) !! (k-1)

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

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn :: IO [Int]

    (putStr . unlines . map (show . solve)) tcs

solve k = xs !! (k-1)
  where
    xs = [x | x <-[1..], x `mod` 3 /= 0 && x `mod` 10 /= 3] :: [Int]

nTh :: Int -> Int
nTh n = iter 1 1
  where
    iter :: Int -> Int -> Int
    iter a b
      | b `mod` 3 == 0 || b `mod` 10 == 3 = iter a (b + 1)
      | a == n = b
      | otherwise = iter (a + 1) (b + 1)

loop :: Int -> IO()
loop 0 = return ()
loop n = do
    number <- readLn :: IO Int
    print (nTh number)
    loop $ n - 1

main :: IO()
main = do
    input <- getLine
    let n = read input :: Int
    loop n

import Data.Array
z  =  listArray (1,1000) $ filter (\x -> x `mod` 3 /= 0 &&   x `mod` 10 /= 3) [1..]
main = interact $ unlines . map (show . ((!) z) . (read :: String -> Int)) . tail  . lines

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    k <- read <$> getLine :: IO Int
    print $ (filter (\x -> x `mod` 3 /= 0 && x `mod` 10 /= 3) [1..]) !! (k - 1)

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  = Int
type OutType = Int

inpLines :: Int
inpLines = 1

solve :: InType -> OutType
solve x = liked !! (x - 1)
    where liked = [ y
                  | y <- [1 .. ]
                  , y `mod` 3 /= 0
                  , y `mod` 10 /= 3
                  ]

receive :: [String] -> InType
receive [s] = read s :: Int
receive _   = error "unexpected input"

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

module Main where

import Control.Monad ( replicateM_ )

main = do
  t <- read <$> getLine
  replicateM_ t
    $ do
      getLine >>= print . solve . read

solve :: Int -> Int
solve k = helper 0 k
  where
    helper itr 0 = itr
    helper itr k = if (itr + 1) `rem` 3 == 0 || (itr + 1) `rem` 10 == 3
                   then helper (itr + 1) k
                   else helper (itr + 1) (k - 1)
{-
>>>solve 1000
1666

-}

--ghc 8.6.3

readLnInt :: IO (Int)
readLnInt = do
  input <- getLine
  return (read input)

getLns' :: Int -> IO([String])
getLns' n
  | n == 0 = return []
  | otherwise = do
    ln <- getLine
    lns <- getLns' (n - 1)
    return (ln:lns)

getLns :: Read a => Int -> IO([a])
getLns n = fmap (fmap read) $ getLns' n

ans = [x | x <- [1..],
           mod x 3 /= 0,
           mod x 10 /= 3]

main = do
  n <- readLnInt
  qs <- (getLns n) :: IO([Int])
  print $ map (\x -> ans !! (x - 1)) qs


import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

getStrs:: Int -> IO [String]
getStrs 0 = return []
getStrs n = do
    x <- getStr
    xs <- getStrs (n-1)
    return (x:xs)

strsOf n = sequence $ take n $ repeat ['a'..'z']
infStrs = concat [strsOf x | x <- [1..]]

solve strs =
    let isValid x = not $ any (isInfixOf x) strs in
    head (filter isValid infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn (solve strs)

import Data.List

main = interact $ solve . words

solve :: [String] -> String
solve (_ : ts) = head $ concatMap (comp' $ dropWhile null $ sort $ concatMap tails ts) newTitles
-- solve (_ : ts) = unlines $ dropWhile null $ sort $ concatMap tails ts

comp' :: [String] -> (Int, [String]) -> [String]
comp' s (i, t) = comp (map (take i) $ filter ((>= i) . length) s) t
  where
  comp _ [] = []
  comp [] (n : ns) = [n]
  comp (o : os) (n : ns)
    | n < o = [n]
    | otherwise = comp (dropWhile (<= n) $ o : os) ns

newTitles :: [(Int, [String])]
newTitles = tail $ zip [0..] $ iterate f [""]
  where
  f xs = [c : x | c <- ['a'..'z'], x <- xs]

module Main(build,find, main, tails) where

import Control.Monad
import Data.Array
import Data.Char (ord, chr)

readi :: [Char] -> Int
readi x = read x :: Int

tails :: [Char] -> [[Char]]
tails [] = []
--tails (x:xs) = [[x]] ++ (map ([x]++) (tails xs))
tails xs = [xs] ++ (tails (tail xs))

data Node = Node (Array Int Node) | Null
	deriving (Show)

instance Eq Node where
	Null == Null = True
	Null == _ = False
	_ == Null = False
	(Node a1) == (Node a2) = a1 == a2

decode x = (ord x) - (ord 'a') + 1
encode x = chr (x - 1 + (ord 'a'))

build :: [[Char]] -> Node
build [] = Null
build ss = Node $ array (1, 26) [(x, call x) | x <- [1..26]]
	where
		fl ss = filter (/=[]) ss
		call x = build $ scanF (fl ss) (encode  x)
		scanF :: [[Char]] -> Char -> [[Char]]
		scanF ss x
			| ss == [] = []
			| head w == x = (tail w):(scanF st x)
			| otherwise = (scanF st x)
				where
					w = head ss
					st = tail ss

merge = foldl (++) []

find :: Node -> [Char]
find v =  minimum $ filtmin $ leafs v
	where
		filtmin ss = filter ((==mm) . length) ss
			where
				mm = minimum $ map (length) ss
		leafs :: Node -> [[Char]]
		leafs Null = [[]]
		leafs (Node arr) = merge [map ([c]++) (acc c) | c <- ['a'..'z']]
			where
				acc :: Char -> [[Char]]
				acc c = leafs (arr ! (decode c))
extract (Node arr) = arr

find2 :: Node -> [Char]
find2 v = reverse $ firstR $ iterate (extendl) (Left [("", v)])
	where
		firstR (x:xs) = case x of
							Left x -> firstR xs
							Right y -> y
		extendl (Left l) = extend l
		extend ls = if ffml == [] then Left ml else Right $ fst $ head $ ffml
			where
				ffml = filter (ff) ml
				ml = mul ls
				ff (_, Null) = True
				ff bb = False
		mul xs = merge [map (\(a,b) -> (([encode a]++rs), b)) (assocs n) | (rs, Node n) <- xs]

main = do
	n <- readi `liftM` getLine
	wrd <- forM [1..n] (\x->getLine)
	--putStrLn $ show $ merge (map (tails) wrd)
	putStr $ find2 $ build $ merge (map (tails) wrd)

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

solve :: [String] -> String
solve ss
  | length chars == 26  =  aa
  | otherwise  =  a
  where
    chars  =  nub $ concat ss
    a  =  [head $ filter (not . flip elem chars) ['a' .. 'z']]
    pairs  =  nub $ concat $ map (\s -> zipWith (\a b -> [a,b]) s (tail s)) ss
    aa  =  head [[a,b] | a <- ['a'..'z'], b <- ['a'..'z'], not (elem [a,b] pairs)]

main :: IO ()
main  =  do
    n  <-  readLn
    ss  <-  replicateM n getLine
    putStrLn $ solve ss

{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.List

main = getLine >> interact f
cs = ['a'..'z']
f x | Just res <- find p $ replicateM 1 cs ++ replicateM 2 cs = res
     where
       p y = not.or $ map (isPrefixOf y) $ tails x

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

getStrs:: Int -> IO [String]
getStrs 0 = return []
getStrs n = do
    x <- getStr
    xs <- getStrs (n-1)
    return (x:xs)

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    print (solve strs)

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

getStrs:: Int -> IO [String]
getStrs 0 = return []
getStrs n = do
    x <- getStr
    xs <- getStrs (n-1)
    return (x:xs)

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    print ("\"" ++ solve strs ++ "\"")

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

getStrs:: Int -> IO [String]
getStrs 0 = return []
getStrs n = do
    x <- getStr
    xs <- getStrs (n-1)
    return (x:xs)

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
    let isValid x = not $ any (isInfixOf x) strs in
    head (filter isValid infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn (solve strs)

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

getStrs:: Int -> IO [String]
getStrs 0 = return []
getStrs n = do
    x <- getStr
    xs <- getStrs (n-1)
    return (x:xs)

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn ("\"" ++ solve strs ++ "\"")


module Main (main) where

import qualified Data.Array as Array
import Data.Array (Array, (!))

pairs :: [a] -> [(a, a)]
pairs (x:y:xs) = (x, y) : pairs xs
pairs _ = []

solve :: (String, String) -> Int
solve (alphabet, letters) =
  let arr = Array.array ('a', 'z') (zip alphabet [1..])
   in sum (zipWith (\a b -> abs (arr ! a - arr ! b)) letters (tail letters))

go :: String -> String
go input =
  let ls :: [String]
      ls = lines input
      x :: String
      xs :: [String]
      (x:xs) = ls
      n :: Int
      n = read x
      ys :: [(String, String)]
      ys = pairs xs
   in unlines $ fmap (show . solve) ys

main :: IO ()
main = interact go

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

charFind (s:ss) charToFind = if s == charToFind then 0
    else 1 + charFind ss charToFind

solve keyMap (c:cs) = if null cs then 0
    else abs(charFind keyMap c-charFind keyMap (head cs)) + solve keyMap cs

run 0 = do return 0
run count = do
    keyMap <- getLine
    textToType <- getLine
    print(solve keyMap textToType)
    run (count-1)
main = do
    n <- getLine
    let n' = read n
    run n'

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    s <- getLine
    t <- getLine
    let indices = map (fromJust . (`elemIndex` s)) t
        moves = map abs $ zipWith (-) indices $ tail indices
    print $ sum moves

import Data.Char
import qualified Data.Map as M
import System.IO

merge :: [a] -> [b] -> [(a, b)]
merge [] _ = []
merge _ [] = []
merge (x : xs) (y : ys) = (x, y) : merge xs ys

distance' :: [Int] -> Int
distance' [] = 0
distance' [x] = 0
distance' (x : y : xs) = abs (y - x) + distance' (y : xs)

distance :: String -> String -> Int
distance keyboard w
  | lenw == 1 = 0
  | otherwise = distance' $ map (km M.!) w
  where
    lenw = length w
    km = M.fromList $ merge keyboard [1 ..]

solve :: [String] -> [String]
solve [] = []
solve (k : w : xs) = ((show $ distance k w) : []) ++ solve xs

main :: IO ()
main = do
  inputs <- getContents
  let lns = lines inputs
  --print lns
  putStr $ unlines $ solve $ tail lns

import qualified Data.Map as M
import Data.Maybe

main = interact solve
solve = unlines . s . tail . lines
s (a:b:xs) = (show (cnt a b)):(s xs)
s _ = []
cnt k w = let m = M.fromList $ zip k [1..]
              s = mapMaybe (flip M.lookup m) w
          in sum $ zipWith (\x y->abs(x-y)) s (tail s)

import Prelude

test :: Int -> IO ()
test 0 = putStrLn ""
test n = do
    alphabets <- getLine
    s <- getLine
    let first  = findIndex alphabets (head s) 0
    let ans = solve alphabets s first
    print ans
    test (n - 1)

main :: IO ()
main = do
    tt <- getLine
    let t = (read tt :: Int)
    test t

solve :: String -> String -> Int -> Int
solve alphabets "" prev = 0
solve alphabets (x : xs) prev =
    let ind = findIndex alphabets x 0
    in abs (ind - prev) + solve alphabets xs ind

findIndex :: String -> Char -> Int -> Int
findIndex "" _ n = -1
findIndex (a : as) x n =
    if x == a
        then n
        else findIndex as x (n + 1)

import Control.Monad
import Data.Char
import Data.Maybe

solve :: IO ()
solve = do
    s <- takeWhile (not . isSpace) <$> getLine
    w <- takeWhile (not . isSpace) <$> getLine
    let pos = zip s [1 :: Int ..]
        getPos c = fromJust $ lookup c pos
    print $ sum [abs (getPos a - getPos b) | (a, b) <- zip w (tail w)]

main :: IO ()
main = flip replicateM_ solve =<< readLn

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

calcEditDist :: [Int] -> [Int] -> Int
calcEditDist [] [] = 0
calcEditDist (x:xs) (y:ys) = (calcEditDist xs ys) + (abs (x-y))

elemIndexwithList :: [Char] -> Char -> Maybe Int
elemIndexwithList a b = elemIndex b a

process 0 = return ()
process t = do
    s <- getLine
    p <- getLine
    let _:a = p
    let b = init p
    let idx0 = map (fromJust . elemIndexwithList s) a
    let idx1 = map (fromJust . elemIndexwithList s) b
    print (calcEditDist idx0 idx1)
    process (t-1)

main = do
    t <- getInt
    process t


import Data.Set
main = interact solve
solve input = output where
  inputs = Prelude.map (fromList . Prelude.map (read::String->Int) . tail . words) $ tail $ lines input
  f [x] = fromList [fromList[head y],fromList(tail y)] where y = toList x
  f (x:xs) = g x xs
  g _ [] = empty
  g x (y:xs) = if Data.Set.null z then g x xs else union (fromList [v,w,z]) (g x xs) where
    z = intersection x y
    v = difference x y
    w = difference y x
  output0 = Prelude.map toList $ toList $ f inputs
  output1 = Prelude.map (\xs->length xs:xs) output0
  output = unlines $ Prelude.map ( unwords . (Prelude.map show)) output1

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Data.Function
import Debug.Trace

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (map read . drop 1 . words <$> getLine)
  let yss = solve xss
      divide 0 zss                  = zss
      divide i (zs@(_ : _) : zss)   = as ++ concat bs : divide (i - length as) zss
        where (as, bs) = splitAt (min i (length zs)) (map (: []) zs)
      divide i (zs : zss)           = zs : divide i zss
      divide _ []                   = error "Never happens"
  forM_ [length ys : ys | ys <- divide (n - length yss) yss] $ \ys -> do
    putStrLn $ intercalate " " $ map show ys

solve :: [[Int]] -> [[Int]]
solve xss = map (snd . unzip) . groupBy ((==) `on` fst) . sort $ do
  let elements = unique $ concat xss
       where unique = map head . group . sort
  e <- elements
  let identity = do
        (i, xs) <- zip [0 ..] xss
        guard $ e `elem` xs
        return i
  return (identity, e)

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Tree
import Data.Graph

solve :: Int -> [[Int]] -> [[Int]]
solve n pairsets
    | n == 2    = [[head $ head pairsets],tail $ head pairsets]
    | otherwise = map (map fst) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ IntMap.assocs ans
  where
    inSet = accumArray (||) False (0,222) [(x,True) | x <- [0..222], y <- [0..222], (arr ! (min x y, max x y)) > 0]
    arr = accumArray (+) 0 ((0,0),(222,222)) $ concatMap list2pairs pairsets
    list2pairs lst = [((x,y),1) | x <- lst, y <- lst, x < y]

    ans = execState (rec (0, 0)) IntMap.empty

    rec :: (Int, Int) -> State (IntMap Int) ()
    rec (v, l) | v > 222 = return ()
    rec (v, l) = do
        map <- get
        let doit = (inSet ! v) && IntMap.notMember v map
        when doit $ dfs (v, l)
        rec (v + 1, if doit then l + 1 else l)

    dfs (v, l) = do
        modify $ IntMap.insert v l
        forM_ [0..222] $ \t -> when (inSet ! t && (arr ! (min v t, max v t)) > 1) $ do
            map <- get
            when (IntMap.notMember t map) $ dfs (t, l)

parseInput = do
    n <- readInt
    pairsets <- replicateM (n * (n - 1) `div` 2) $ do
        k <- readInt
        replicateM k readInt
    return (n, pairsets)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace

main = do
    (n, pairsets) <- evalState parseInput <$> BS.getContents
    let answer = solve n pairsets
    forM_ answer $ \lst -> do
        putStr $ show $ length lst
        forM_ lst $ \num -> do
            putChar ' '
            putStr $ show num
        putChar '\n'

--{{{ Start of a minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

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

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

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

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

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
--}}} end of a minimal State Monad

module Main where

import Data.List
import Text.Printf

main = interact in2out

in2out input
  = output
  where
    [n]:ls = map (map (read :: String->Int))
           $ map words
           $ lines input
    output = unlines
           $ itrSolve n
           $ sort
           $ map sort
           $ take (div (n*(n-1)) 2)
           $ map tail ls

itrSolve 2 [x:xs]
  = [format [x] , format xs]

itrSolve n ls@(x:y:_)
  = format fst : solve ls' fst
  where
    fst = myInter x y
    ls' = take (n-1) ls

myInter alla@(a:as) allb@(b:bs)
  | a==b
  = a : myInter as bs
  | a<b
  = myInter as allb
  | otherwise
  = myInter alla bs

myInter _ _
  = []

format xs
  = unwords
  $ map show
  $ length xs : xs

solve [] _
  = []

solve (x:xs) ls
  = format (remove x ls) : solve xs ls

remove [] _
  = []

remove x []
  = x

remove (x:xs) alll@(l:ls)
  | x==l
  = remove xs ls
  | otherwise
  = x : remove xs alll

import List

set n = [n]

sets n = map set [1..n]

test n = [mergerSorted (sets n !! i) (sets n !! j) | i <- [0..n-1], j <- [0..n-1], i < j]

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

mergerSorted :: [Int] -> [Int] -> [Int]
mergerSorted as [] = as
mergerSorted [] bs = bs
mergerSorted (a:as) (b:bs)
  | a <  b  =  a:(mergerSorted as (b:bs))
  | a >  b  =  b:(mergerSorted (a:as) bs)
  | a == b  =  a:(mergerSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (mergerSorted b d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = if n > 2 then take n (solve mns) else [[head (head mns)]] ++ [tail (head mns)]
  printAns ans

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Debug.Trace

solve :: [[Int]] -> [[Int]] -> [[Int]]
solve acc []          = [length ys : ys | ys <- sort acc]
solve acc (xs : xss)  = do
  let x = head xs
      (ass, bss) = span ((== x) . head) xss
      ys | null ass   = [x]
         | otherwise  =  foldl' intersect xs ass
  solve (ys : acc) (sort . filter (not. null) $ (map (\\ ys) ass) ++ bss)

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (sort . map read . drop 1 . words <$> getLine)
  forM_ (solve [] (sort xss)) $ \xs -> do
    putStrLn $ intercalate " " $ map show xs

import List

set n = [n]

sets n = map set [1..n]

test n = [mergerSorted (sets n !! i) (sets n !! j) | i <- [0..n-1], j <- [0..n-1], i < j]

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

mergerSorted :: [Int] -> [Int] -> [Int]
mergerSorted as [] = as
mergerSorted [] bs = bs
mergerSorted (a:as) (b:bs)
  | a <  b  =  a:(mergerSorted as (b:bs))
  | a >  b  =  b:(mergerSorted (a:as) bs)
  | a == b  =  a:(mergerSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (mergerSorted b d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = take n (solve mns)
  printAns ans

import List

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (b ++ d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = solve mns
  printAns ans

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Function
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map

solve :: Int -> [[Int]] -> [[Int]]
solve n pairsets =
    map (map fst) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ Map.assocs ans
  where
    inSet = accumArray (||) False (0,222) [(x,True) | x <- [0..222], y <- [0..222], (arr ! (min x y, max x y)) > 0]
    arr = accumArray (+) 0 ((0,0),(222,222)) $ concatMap list2pairs pairsets
    list2pairs lst = [((x,y),1) | x <- lst, y <- lst, x < y]

    ans = execState (rec (0, 0)) Map.empty

    rec :: (Int, Int) -> State (Map.Map Int Int) ()
    rec (v, l) | v > 222 = return ()
    rec (v, l) = do
        map <- get
        let doit = (inSet ! v) && Map.notMember v map
        when doit $ dfs (v, l)
        rec (v + 1, if doit then l + 1 else l)

    dfs (v, l) = do
        modify $ Map.insert v l
        forM_ [0..222] $ \t -> when (inSet ! t && (arr ! (min v t, max v t)) > 1) $ do
            map <- get
            when (Map.notMember t map) $ dfs (t, l)

parseInput = do
    n <- readInt
    pairsets <- replicateM (n * (n - 1) `div` 2) $ do
        k <- readInt
        replicateM k readInt
    return (n, pairsets)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace

main = do
    (n, pairsets) <- evalState parseInput <$> BS.getContents
    let answer = solve n pairsets
    forM_ answer $ \lst -> do
        putStr $ show $ length lst
        forM_ lst $ \num -> do
            putChar ' '
            putStr $ show num
        putChar '\n'

--{{{ Start of a minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

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

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

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

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

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
--}}} end of a minimal State Monad

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Unsafe.Coerce
import qualified Data.IntSet as Set

solve :: [[Int]] -> [[Int]] -> [[Int]]
solve acc []          = [length ys : ys | ys <- sort acc]
solve acc (xs : xss)  = do
  let x = head xs
      (ass, bss) = partition ((== x) . head) xss
      ys = foldl' intersect xs ass
  solve (ys : acc) (sort . filter (not. null) $ (map (\\ ys) ass) ++ bss)

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (sort . map read . drop 1 . words <$> getLine)
  forM_ (solve [] (sort xss)) $ \xs -> do
    putStrLn $ intercalate " " $ map show xs


import Control.Applicative
import Data.Char
import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- fmap (C.map (\i -> if isSpace i then ' ' else i)) C.getLine
  C.putStr $ C.unlines $ map (('<' `C.cons`) . (`C.snoc` '>')) $ parse s

import System.IO (isEOF)
import Data.Char (isSpace)
import Control.Monad (when)

data State = Argument | Quotes
    deriving Eq

main = do
    solve Nothing

solve state = do
    end <- isEOF
    if end
        then do
            when (state == Just Argument) $ putChar '>'
            return ()
        else do
            ch <- fmap (\ch -> if isSpace ch then ' ' else ch) getChar
            case state of
                Nothing       -> case ch of
                                     ' ' -> solve Nothing
                                     '"' -> putChar '<' >> solve (Just Quotes)
                                     _   -> putChar '<' >> putChar ch  >> solve (Just Argument)
                Just Argument -> case ch of
                                     ' ' -> putChar '>' >> putChar '\n' >> solve Nothing
                                     _   -> putChar ch  >> solve (Just Argument)
                Just Quotes   -> case ch of
                                     '"' -> putChar '>' >> putChar '\n' >> solve Nothing
                                     _   -> putChar ch  >> solve (Just Quotes)

import Data.List
import Data.Char(isSpace)

rstrip = reverse . dropWhile isSpace . reverse

main = interact $ write . solve . rstrip

write :: [String] -> String

write = unlines . (map (\x -> "<" ++ x ++ ">"))

solve :: String -> [String]

solve ('"' : rest) =
    [token] ++ (solve rest')
        where
            token = takeWhile (/= '"') rest
            rest' = tail $ dropWhile (/= '"') rest

solve (' ' : rest) =
    solve $ dropWhile (== ' ') rest

solve "" =
    []

solve rest =
    [takeWhile (/= ' ') rest] ++ (solve $ dropWhile (/= ' ') rest)

solve :: String -> [String]
solve s  =  solveSpace "" s
  where
    solveSpace word ""
      | null word  =  []
      | otherwise  =  [reverse word]
    solveSpace word (c:s)
      | c == ' ' && null word  =  solveSpace "" s
      | c == ' '  =  (reverse word) : solveSpace "" s
      | c == '"'  =  solveQuote "" s
      | otherwise  =  solveSpace (c : word) s
    solveQuote word (c:s)
      | c == '"'  =  (reverse word) : solveSpace "" s
      | otherwise  =  solveQuote (c : word) s

putStrLn' :: String -> IO ()
putStrLn' s  =  putStrLn $ concat ["<", s, ">"]

main :: IO ()
main  =  getLine >>= mapM_ putStrLn' . solve

import Data.List

split :: (Show a, Eq a) => a -> [a] -> [[a]]
split x xs = let (fst, rest) = break (== x) xs in case rest of
    [] -> [fst]
    (_:rest) -> fst:split x rest

main = do
    s <- getLine
    putStr $ concatMap (\x -> "<" ++ x ++ ">\n")
           $ concat $ zipWith ($) (cycle [words, return]) $ split '"' s

import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- C.getLine
  C.putStr $ C.unlines $ map (('<' `C.cons`) . (`C.snoc` '>')) $ parse s

import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- C.getLine
  C.putStrLn $ ('<' `C.cons`) $ (`C.snoc` '>') $ C.intercalate (C.pack ">\n<") $ parse s


import Data.List (sort, group)

main = do
  		interact (show. length. group. sort. tail. lines)

main=interact((\(n:s)->show$length$foldl(\b x->if(elem x b)then(b)else(x:b)) [] s).map(words).lines)

import Data.List (sort, group)
main = do interact (show . length . group . sort . tail . lines)
{-

-}

import Data.List
main = do
	n<-getLine
	s<-getContents
	putStrLn $ show $ solve (lines s)
solve s = length $ nub s

import List
main = interact (show.length.nub.tail.lines)

--  44A

import List (nub)

getTuple :: String -> (String, String)
getTuple s  =  (s1, s2)
  where
    [s1, s2]  = words s

main :: IO ()
main  =  getLine >> fmap lines getContents >>= print . length . nub . map getTuple

main = interact solve
solve input = output where
  n0:leaves = lines input
  n = read n0::Int
  output = show $ answer leaves
  answer [] = 0
  answer (x:xs) = answer xs + if or $ map (== x) xs then 0 else 1


import Data.List

solve :: String -> String
solve s
  = r
    where
      lowered = concatMap (take 2) (group s)
      r = concat $ no2cons (group lowered) False

      no2cons :: [[Char]] -> Bool -> [[Char]]
      no2cons [] _                 = []
      no2cons ([x] : rest) _       = [x] : no2cons rest False
      no2cons ([x,y] : rest) False = [x,y] : no2cons rest True
      no2cons ([x,y] : rest) True  = [x] : no2cons rest False

main = interact solve

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

encode :: String -> [(Char,Int)]
encode = map (head &&& length) . group

decode :: [(Char,Int)] -> String
decode = concat . map (\(ch,i) -> take i (repeat ch))

fixTypo :: [(Char,Int)] -> [(Char,Int)]
fixTypo = go False
    where
    go _ [] = []
    go _ ((ch,1):l) = (ch,1):go False l
    go False ((ch,i):l) = (ch,2):go True l
    go True  ((ch,i):l) = (ch,1):go False l

main = do
    s <- encode <$> getLine
    let s1 = fixTypo s
    putStrLn $ decode s1

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: String -> String
solve (a:b:c:d:s)
  | a == b && b == c  =  solve (b:c:d:s)
  | a == b && c == d  =  solve (a:b:c:s)
  | otherwise  =  a : solve (b:c:d:s)
solve (a:b:c:[])  =  [a, b] <?> [a, b, c] $ a == b && b == c
solve s  =  s

main :: IO ()
main  =  getLine >>= putStrLn . solve

module Main where
-- import Control.Applicative
import Data.List (group)
main :: IO ()
main = do
  w <- getLine
  let gw = map (\ g@(c:_) -> (c, length g)) $ group w
      ff (c,n) (b,l) =
        if b && n > 1
          then (False, (c,1):l)
          else (n > 1, (c,min 2 n):l)
      (_, fixed) = foldr ff (False, []) gw
      s = concatMap (uncurry $ flip replicate) fixed
  putStrLn s

import Data.List

solve :: String -> String
solve s
  = r
    where
      lowered = concatMap (take 2) (group s)
      r = concat $ no2cons (group lowered) False

      no2cons :: [[Char]] -> Bool -> [[Char]]
      no2cons [] _                 = []
      no2cons ([x] : rest) _       = [x] : no2cons rest False
      no2cons ([x,y] : rest) False = [x,y] : no2cons rest True
      no2cons ([x,y] : rest) True  = [x] : no2cons rest True

main = interact solve


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

main :: IO ()
main =
  interact $
  lines >>>
  tail >>> map (words >>> map read >>> solve >>> bool "NO" "YES") >>> unlines

solve :: [Int] -> Bool
solve [r, b, d] =
  let x = min r b
      y = max r b
   in (y - 1) `div` x <= d

{-# LANGUAGE BangPatterns #-}

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Bool

solve :: Integer -> Integer -> Integer -> Output
solve r b d = (d+1) * (min r b) >= max r b

plotResult :: Output -> IO ()
plotResult False = putStrLn "NO"
plotResult True = putStrLn "YES"

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[r, b, d] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve r b d
	return ()

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

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let j = sort $ take 2 n :: [Int]

        let u = if last j `rem` head j == 0
            then (last j - head j) `div` head j
            else (last j - head j) `div` head j + 1

        putStrLn $ if u <= last n
            then "YES"
            else "NO"

    forM_ [1..t] solve

import Control.Monad
import Data.List
import Data.Int

calc :: Int64 -> Int64 -> Int64 -> String
calc r b d | r > b = calc b r d
calc r b d =
  if b - r <= r * d then
    "YES"
  else
    "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [r,b,d] = map read $ words line :: [Int64]
    putStrLn $ calc r b d

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

readInts = fmap (map read.words) getLine :: IO [Integer]

printS = do
    [r,b,d]<-readInts
    let red = min r b
        blue = max r b
    putStrLn $ if blue >= red && blue <= red + d*red then "YES"
        else "NO"

main = do
    t<-readLn
    replicateM_ t printS

solve::[Int]->[String]
solve (r:b:d:xs)
  | ((max r b) `div` (min r b)) - t > d = "No" : solve xs
  | otherwise                       = "Yes" : solve xs
  where t = if ((max r b) `rem` (min r b)) == 0 then 1 else 0
solve [] = []

main = interact $ unlines . solve . map read . tail . words

import Control.Monad

readInt :: IO Integer
readInt = readLn

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Integer]
readInts = readArray

solve :: Integer -> Integer -> Integer -> Bool
solve mi ma d = ma <= (d + 1) * mi

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

solveCase :: IO String
solveCase = do
  [a, b, d] <- readInts
  return $ ans $ solve (min a b) (max a b) d

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

{-# LANGUAGE BangPatterns #-}

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Bool

solve :: Integer -> Integer -> Integer -> Output
solve r b d
	| max (r-b) (b-r) <= d = True
	| d > 1 && r > b && b > 1 = solve (max 1 $ r - (b+d)) (b-1) d
	| d > 1 && b > r && r > 1 = solve (max 1 $ b - (r+d)) (r-1) d
	| otherwise = False

plotResult :: Output -> IO ()
plotResult False = putStrLn "NO"
plotResult True = putStrLn "YES"

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[r, b, d] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve r b d
	return ()

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

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let j = sort $ take 2 n :: [Int]

        putStrLn $ if last j <= (head j * (last n + 1))
            then "YES"
            else "NO"
    forM_ [1..t] solve

import Control.Monad.RWS.Lazy (forM_)

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let p = min (head n) (n !! 1) :: Int
        let u = sum (take 2 n) - 2 * p :: Int
        let x = u `div` p + u `rem` p :: Int

        putStrLn $ if x <= last n
            then "YES"
            else "NO"

    forM_ [1..t] solve

import Control.Monad
import Data.List

calc :: Int -> Int -> Int -> String
calc r b d | r > b = calc b r d
calc r b d =
  if b - r <= r * d then
    "YES"
  else
    "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [r,b,d] = map read $ words line :: [Int]
    putStrLn $ calc r b d

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

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

printS = do
    [r,b,d]<-readInts
    let red = min r b
        blue = max r b
    putStrLn $ if blue >= red && blue <= red + d*red then "YES"
        else "NO"

main = do
    t<-readLn
    replicateM_ t printS


import Control.Monad ( forM_ )

main = do
  n <- readLn
  forM_ [1..n] $ const $ do
    let myGet = fmap (fmap read . words) getLine
    [b, hC, cC] <- myGet
    [hP, cP] <- myGet
    let maxBC = b `div` 2
    if hP > cP then do
      let hBC = min maxBC hC
          cBC = min (maxBC - hBC) cC
      print $ hBC * hP + cBC * cP
    else do
      let cBC = min maxBC cC
          hBC = min (maxBC - cBC) hC
      print $ hBC * hP + cBC * cP

f -. g = g . f

main = do
	getLine
	interact $ lines -. map words -. map (map read) -. foo -. map bar -. map show -. unlines

foo [] = []
foo  (x1:x2:xs) = (x1++x2) : (foo xs)

bar :: [Int] -> Int
bar (b:p:f:h:c:[]) =
	let
		b2 = div b 2
	in if h>c
		then h*(min p b2)+c*(min f (b2-(min p b2)))
		else c*(min f b2)+h*(min p (b2-(min f b2)))

import Control.Monad
import Data.Maybe
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    print $ maximum $ 0 : catMaybes [ guard (2*(n1+n2) <= b) *>
                                  guard (n1 <= r1) *>
                                  guard (n2 <= r2) *>
                                  return (n1*p1 + n2*p2)
                                | n1 <- [0..100], n2 <- [0..100] ]

gint :: IO Int
gint = fmap read getLine

main = do
    t <- gint
    mymain t

mymain 0 = return ()
mymain x = do
    strabc <- getLine
    strde <- getLine
    let [a,b,c] = map read $ words strabc
    let [d,e] = map read $ words strde
    let aa = a `div` 2
    if (d > e)
        then print (solve aa b c d e)
        else print (solve aa c b e d)
    mymain (x - 1)

solve a b c d e =
    let one = min a b
        two = max 0 (min (a-one) c) in
    (one * d + two * e)

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

onecase= do
		[b,p,f]<- map read <$> words <$> getLine ::IO [Int]
		[h,c]<- map read <$> words <$> getLine :: IO [Int]
		let pp1 = (min p (div b 2)) *h
		let cp1 = (min f (div (b-p*2) 2)) *c
		let cp2 = (min f (div b 2)) *c
		let pp2 = (min p (div (b-f*2) 2)) *h
		print $ if h>c then (max 0 pp1)+(max 0 cp1) else (max 0 pp2)+(max 0 cp2)

main::IO ()
main=do
	s<- read <$> getLine:: IO Int
	replicateM_ s onecase

--ghc 7.10

import Data.List(sortBy)

makeBurgers :: (Integral a, Num b) => a -> a -> b -> (a,b)
makeBurgers b p c = (b',v')
    where
        d = min (b `div` 2) p
        b' = b - 2 * d
        v' = fromIntegral d * c

makeAllBurgers :: (Integral a, Num b, Ord b) => a -> [a] -> [b] -> b
makeAllBurgers b' ps' cs' = f b' (sortBy (\(_,c1) (_,c2) -> compare c2 c1) $ zip ps' cs')
    where
        f 0 _ = 0
        f _ [] = 0
        f b ((p,c):xs) = v + f bnew xs
            where (bnew, v) = makeBurgers b p c

process :: Int -> IO ()
process t
    | t <= 0 = return ()
    | otherwise = do
        line1 <- getLine
        let words1 = words line1
        let b = read $ head words1 :: Int
        let ps = map read $ tail words1 :: [Int]
        line2 <- getLine
        let cs = map read . words $ line2 :: [Int]
        print $ makeAllBurgers b ps cs
        process (t-1)

main = do
    tStr <- getLine
    let t = read tStr :: Int
    process t

import Control.Monad
import Data.Maybe
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    print $ maximum $ 0 : catMaybes [ guard (2*(n1+n2) <= b) *>
                                  guard (n1 <= r1) *>
                                  guard (n2 <= r2) *>
                                  return (n1*p1 + n2*p2)
                                | n1 <- [1..100], n2 <- [1..100] ]

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [b,p,f] <- map read . words <$> getLine
    [h,c] <- map read . words <$> getLine
    if h > c then let n1 = min (b `div` 2) p
                      b' = b - 2*n1
                  in print $ h*n1 * c*min (b' `div` 2) f
      else let n1 = min (b `div` 2) f
               b' = b - 2*n1
               in print $ c*n1 + h*min (b' `div` 2) p

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    if p1 > p2 then let n = min (b `div` 2) r1
                        b' = b - 2*n
                  in print $ p1*n * p2*min (b' `div` 2) r2
      else let n = min (b `div` 2) r2
               b' = b - 2*n
               in print $ p2*n + p1*min (b' `div` 2) r1

import Control.Monad

main = do
  n <- readLn
  forM_ [1..n] $ const $ do
    let myGet = fmap (fmap read . words) getLine
    [b, hC, cC] <- myGet
    [hP, cP] <- myGet
    let maxBC = b `div` 2
    if hP < cP then do
      let hBC = min maxBC hC
          cBC = min (maxBC - hBC) cC
      print $ hBC * hP + cBC * cP
    else do
      let cBC = min maxBC cC
          hBC = min (maxBC - cBC) hC
      print $ hBC * hP + cBC * cP


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

getInt :: IO Int
getInt = parseInt <$> C.getLine

data Tree = Empty | Node Int Tree Tree

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    as <- replicateM n getInt
    let func _ [] = (Empty, [])
        func i (x : xs)
          | i == x = (Node i t' t'', xs'')
          | otherwise = (Empty, x : xs)
          where (t', xs') = func 1 xs
                (t'', xs'') = func (i + 1) xs'
        dfs :: Bool -> Builder -> Tree -> IO ()
        dfs _ _ Empty = return ()
        dfs flag builder (Node x child sibling) = do
          let builder' = if flag then builder `mappend` charUtf8 '.' `mappend` intDec x else intDec x
          hPutBuilder stdout $ builder' `mappend` charUtf8 '\n'
          dfs True builder' child
          dfs flag builder sibling
    dfs False mempty $ fst $ func 1 as

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

nextLi :: Int -> [Int] -> [Int]
nextLi ai pre = let
  rv (v : vs)
    | ai == v + 1  = ai : vs
    | otherwise = rv vs
  rv [] = error "bad input"
  in  if  ai == 1
  then  1 : pre
  else  rv pre

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    (\fun -> foldM_ fun [] (replicate n ())) $ \pre () -> do
      [ai] <-  readInts
      let  res = nextLi ai pre
      res <$ putInts (reverse res)

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 '.') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


import Control.Arrow ((>>>))

main = interact $ words >>> drop 1 >>> chunksOf 2 >>> map solve >>> unlines

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

solve :: [String] -> String
solve [_, s]
  | even fz || fz == 1 = "BOB"
  | otherwise = "ALICE"
  where
    fz = count '0' s
    count c = length . filter (== c)

module Main where

    solve :: IO ()
    solve = do
        getLine
        s <- getLine
        let cnt = length $ filter (== '0') s
        putStrLn $ if cnt == 1 then
                "BOB"
            else if cnt `mod` 2 == 1 then
                "ALICE"
            else
                "BOB"

    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

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- getLine
        s <- getLine
        let z = length $ filter (== '0') s
        putStrLn $ if even z || z == 1 then "BOB" else "ALICE"

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | numZero == 0 = "DRAW"
                     | numZero == 1 = "BOB"
                     | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

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
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    return $ stringUtf8 (if odd n && C.index str (n `div` 2) == '0' && C.count '0' str > 1 then "ALICE" else "BOB") `mappend` charUtf8 '\n'
  hPutBuilder stdout result

main = interact (unlines . g . tail .  lines)

g [] = []
g (x:y:xs) = (f y: g xs)
f::String->String
f y | rem t 2 == 0 = "BOB"
  | t == 1 = "BOB"
  |otherwise = "ALICE"
  where t = count '0' y

count x [] = 0
count x (y:ys) |x==y = 1 + count x ys
count x y = count x (tail y)

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | numZero == 0 = "DRAW"
                     | ((length l) == 1) && (numZero == 1) = "BOB"
                     | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) = "ALICE"
                     | (odd . length $ l) && (even numZero) = "BOB"
                     | (even . length $ l) && (numZero == length l) = "DRAW"
                     | (even . length $ l) && (numZero /= length l) = "BOB"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad (replicateM)
import Data.Sequence (mapWithIndex)

main = do t <- read <$> getLine
          replicateM t solve

solve = do xs <- getLine
           putStrLn (show (countBeautiful xs (length xs)))

countBeautiful :: String -> Int -> Int
indicativeFunc :: (Int, Char) -> Int
indicativeFunc (i,a) | a == '1' && (even i) = 0
                     | a == '1' && (odd i) = 1
                     | a == '0' && (even i) = 1
                     | a == '0' && (odd i) = 0
                     | otherwise = 2
createIndicator :: [Char] -> [Int]
createIndicator x = (map indicativeFunc (zip [0..length x -1] x)) ++ [3]
--evenFunc :: [Int] -> Int -> Int
--evenFunc indi i | (indi !! i == 1 || indi !! i == 2) = evenFunc indi (i+1)
--                | otherwise = i

evenFunc :: [Int] -> [Int] -> Int -> Int -> [Int]
evenFunc indi acc idx prev | idx == length indi = reverse acc
                           | indi !! (length indi - idx - 1) == 0 = evenFunc indi (acc++[length indi - idx - 1]) (idx+1) (length indi - idx - 1)
                           | otherwise = evenFunc indi (acc ++ [prev]) (idx + 1) (prev)

oddFunc :: [Int] -> [Int] -> Int -> Int -> [Int]
oddFunc indi acc idx prev | idx == length indi = reverse acc
                          | indi !! (length indi - idx - 1) == 1 = oddFunc indi (acc++[length indi - idx - 1]) (idx+1) (length indi - idx - 1)
                          | otherwise = oddFunc indi (acc ++ [prev]) (idx + 1) (prev)
--oddFunc :: [Int] -> Int -> Int
--oddFunc indi i | (indi !! i == 0 || indi !! i == 2) = oddFunc indi (i+1)
--               | otherwise = i
countBeautiful x n = sum maxOfTwo - (n*(n+1) `div` 2)
                      where indicator = createIndicator x
                            evenLs = evenFunc indicator [] 0 (n)
                            oddLs = oddFunc indicator [] 0 (n)
                            maxOfTwo = [max x y | (x,y) <- zip evenLs oddLs]

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) && (odd ((numZero-1) `div` 2)) = "ALICE"
                     | (odd . length $ l) && (odd numZero) && (even ((numZero-1) `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (odd (numZero `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (even (numZero `div` 2)) = "DRAW"
                     | (even . length $ l) && (odd (numZero `div` 2)) = "BOB"
                     | (even . length $ l) && (even (numZero `div` 2)) = "DRAW"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn (caseString l numZero)

import Control.Monad

main = do t <- read <$> getLine
          replicateM t solve

caseString :: String -> Int -> String
caseString l numZero | (odd . length $ l) && (odd numZero) && (odd ((numZero-1) `div` 2)) = "ALICE"
                     | (odd . length $ l) && (odd numZero) && (even ((numZero-1) `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (odd (numZero `div` 2)) = "BOB"
                     | (odd . length $ l) && (even numZero) && (even (numZero `div` 2)) = "DRAW"
                     | (even . length $ l) && (odd (numZero `div` 2)) = "BOB"
                     | (even . length $ l) && (even (numZero `div` 2)) = "DRAW"

solve = do trash <- getLine
           l <- getLine
           let numZero = (length . filter (=='0')) l
           putStrLn . show $ (caseString l numZero)

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
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.take n <$> C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ stringUtf8 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

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
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ stringUtf8 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

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
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
        isMiddleZero = odd n && C.index str (n `div` 2) == '0'
        level = zeroNum `div` 2
    return $ string7 (if isMiddleZero then (if odd level then "ALICE" else "BOB") else (if even level then "DRAW" else "BOB")) `mappend` charUtf8 '\n'
  hPutBuilder stdout result

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
  result <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    str <- C.getLine
    let zeroNum = C.count '0' str
    return $ string7 (if odd n && C.index str (n `div` 2) == '0' || zeroNum /= 0 && zeroNum `mod` 4 /= 0 then "BOB" else "DRAW") `mappend` charUtf8 '\n'
  hPutBuilder stdout result

import Control.Arrow ((>>>))

main = interact $ words >>> drop 1 >>> chunksOf 2 >>> map solve >>> unlines

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

solve :: [String] -> String
solve [ns, s]
  | even n = "BOB"
  | (s !! (n `div` 2)) == '1' = "BOB"
  | length (filter (== '0') s) == 1 = "BOB"
  | otherwise = "DRAW"
  where
    n = read ns


import Data.List
main=do
 v<-map read.tail.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main = interact $ show . process . map read . tail. words
process :: [Int] -> Int
process x = maximum $ map (\z -> if head z then length z else 0) $ group $ map (== mm) x
    where mm = maximum x

import Data.List
main=map read.tail.words<$>getContents>>=(print.snd.maximum.map(\x->(head x::Int,length x)).group)

import Data.List
import Control.Monad

main = do
  n <- readLn :: (IO Int)
  v <- (map (read :: String->Int)) . words <$> getLine
  print $ maximum $ map length $ filter (\x -> head x == maximum v) $ group v

import Data.List

main = do
  n <- getLine
  v <- (map (read :: String->Int)) . words <$> getLine
  print $ maximum $ map length $ filter (\x -> head x == maximum v) $ group v

import Data.List
main=getContents>>=print.snd.maximum.map(\x->(head x::Int,length x)).group.map read.tail.words

import Data.List
main=do
 _<-getLine
 v<-map read.words<$>getLine
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main=interact$show.snd.maximum.map(\x->(read$head x::Int,length x)).group.tail.words

import Data.List
main=interact$show.snd.maximum.map(\x->(head x::Int,length x)).group.map read.tail.words

import Data.List
main=do
 v<-map read.tail.words<$>getContents
 print$foldr(max.length.filter(==(maximum v::Int)))0$group v

import Data.List
main=do
 _<-getLine
 v<-(map read).words<$>getLine
 print$maximum$map length$filter(\x->head x==maximum v)$group(v::[Int])

import Data.List
main=map read.tail.words<$>getContents>>=(\v->print$snd$maximum$map(\x->(head x::Int,length x))$group v)

import Data.List
main=do
 _<-getLine
 v<-map read.words<$>getLine
 print$maximum$map(length.filter(==maximum v))$group(v::[Int])

import Data.List
main=do
 v<-map read.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main=do
 v<-map read.words.tail<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group(v::[Int])

import Data.List
main = interact $ show . process . map read . tail. words
process :: [Int] -> Int
process [_] = 1
process x = 1 + (maximum $ map (\z -> if head z then length z else 0) $ group $ zipWith (==) x $ tail x)

import Data.List
main=do
 v<-map read.words<$>getContents
 print$foldr(max.length.filter(==maximum v))0$group$tail(v::[Int])


module Main where

import Control.Monad
import Data.List as L
import Data.Map as M
import Data.ByteString.Char8 as C
import Data.ByteString as BS

readInts :: Int -> ByteString -> ([Int],ByteString)
readInts n bs =
  L.foldl (\(ints, bs') _ -> let
              bs'' = C.dropWhile (\x -> x == ' ' || x == '\r' || x == '\n') bs'
              Just (int, bs''') = C.readInt bs''
              in (int : ints, bs''')) ([], bs) [1..n]

main :: IO ()
main = do
  n <- fmap read Prelude.getLine
  input <- BS.getContents
  let (sequences, _) = L.foldl (\(xs, bs) _ ->
                                 let ([si], bs') = readInts 1 bs
                                     (xi, bs'') = readInts si bs'
                                 in (xi : xs, bs'')) ([], input) [1..n]
      sequences' = L.zip [1..n] $ L.reverse $ L.map L.reverse sequences
      mutations = L.map (\(i, seqq) ->
                           let sum = L.sum seqq
                               seqEnum = L.zip [1..(L.length seqq)] seqq
                           in [(sum - x, i, ix) | (ix, x) <- seqEnum]) sequences'
      orderedBySum = sortBy (\(sum,_,_) (sum',_,_) -> compare sum sum') $ Prelude.concat mutations
      groupedMatches = L.groupBy (\(sum,i,_) (sum',i',_) -> sum == sum' && i == i') orderedBySum
      noDuplicates = L.map L.head groupedMatches
      finalGrouping = L.groupBy (\(sum,_,_) (sum',_,_) -> sum == sum') noDuplicates
      matches = L.filter ((<=) 2 . L.length) finalGrouping
  if L.null matches then
    Prelude.putStrLn "NO"
  else do
    Prelude.putStrLn "YES"
    let match = L.take 2 . L.head $ matches
    forM_ match (\(_,ii,i) -> Prelude.putStrLn $ show ii ++ " " ++ show i)

module Main where

import Data.List as L
import Data.Map as M
import Control.Monad
import Data.ByteString.Char8 as C
import Data.ByteString as BS

readInts :: Int -> ByteString -> ([Int],ByteString)
readInts n bs =
  L.foldl (\(ints,bs') _ -> let
              bs'' = C.dropWhile (\x -> x == ' ' || x == '\r' || x == '\n') bs'
              Just (int,bs''') = C.readInt bs''
              in (int:ints,bs''')) ([],bs) [1..n]

main :: IO ()
main = do
  n <- fmap read Prelude.getLine
  input <- BS.getContents
  let (sequences,_) = L.foldl (\(xs, bs) _ ->
                                 let ([si],bs') = readInts 1 bs
                                     (xi,bs'') = readInts si bs'
                                 in (xi:xs,bs'')) ([],input) [1..n]
      sequences' = L.zip [1..n] $ L.reverse $ L.map L.reverse sequences
      mutations = L.map (\(i,seqq) ->
                           let sum = L.sum seqq
                               seqEnum = L.zip [1..(L.length seqq)] seqq
                           in [(sum - x,i,ix) | (ix,x) <- seqEnum]) sequences'
      orderedBySum = sortBy (\(sum,_,_) (sum',_,_) -> compare sum sum') $ Prelude.concat mutations
      groupedMatches = L.groupBy (\(sum,i,_) (sum',i',_) -> sum == sum' && i == i') orderedBySum
      noDuplicates = L.map L.head groupedMatches
      finalGrouping = L.groupBy (\(sum,_,_) (sum',_,_) -> sum == sum') noDuplicates
      matches = L.filter ((<=) 2 . L.length) finalGrouping
  if L.null matches then
    Prelude.putStrLn "NO"
  else do
    Prelude.putStrLn "YES"
    let match = L.take 2 . L.head $ matches
    forM_ match (\(_,ii,i) -> Prelude.putStrLn $ show ii ++ " " ++ show i)


fn:: String -> Int
fn str = if existAtEdge then 2 else 4
    where
        existAtEdge = oneExist (head table) || oneExist (last table) || oneExist (map head table) || oneExist (map last table)
        oneExist:: [Char] -> Bool
        oneExist = any (== '1')
        n:: Int
        n = read $ (words $ head ls) !! 0
        m:: Int
        m = read $ (words $ head ls) !! 1
        table:: [[Char]]
        table = map lineEntries (tail ls)
            where
                lineEntries:: String -> [Char]
                lineEntries line = map (!! 0) $ words line
        ls = lines str

main = do
    input <- getContents
    output <- return $ show $ fn input
    putStrLn output

import Control.Monad
import Control.Applicative

check :: [ [ Int ] ] -> Bool
check mat
  = elem 1 (mat !! 0)       ||
    elem 1 (mat !! (n - 1)) ||
    elem 1 (map (!! 0) mat) ||
    elem 1 (map (!! (m-1)) mat)
    where
      n = length mat
      m = length (mat !! 0)

main :: IO ()
main = do

  [ x, y ] <- map read <$> words <$> getLine

  mat <- replicateM x $
    map read <$> words <$> getLine

  if check mat
    then print 2
    else print 4

import Data.Tuple
import Data.List
cal ls = let ns = map words $ tail ls
	     t = transpose ns
	     edges = (head ns) ++ (last ns) ++ (head t) ++ (last t)
	 in if (any (\s ->read s==1) edges) then 2 else 4

main = interact (show . cal . lines)

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

solve :: [Int] -> Int
solve (n:m:a) = solve' a 1 1
    where
        solve' :: [Int] -> Int -> Int -> Int
        solve' []     _ _ = 4
        solve' (1:ax) i j | i == 1 || i == n = 2
                          | j == 1 || j == m = 2
        solve' (_:ax) i j | j == m           = solve' ax (i + 1) 1
                          | otherwise        = solve' ax i (j + 1)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m] <- getInts
  as <- replicateM n getInts

  let
    xys = map fst $ filter ((== 1) . snd) $ zip [(x, y) | x <- [1..n], y <- [1..m]] $ concat as

  print $
    if not . null $ filter (\(x, y) -> x == 1 || x == n || y == 1 || y == m) xys
     then 2
     else 4

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m] <- readLns
    l <- replicateM n readLns :: IO [[Int]]
    let a = head l
        b = last l
        c = head $ transpose l
        d = last $ transpose l
    if any (==1) $ concat [a,b,c,d] then
        print 2
    else
        print 4

import Control.Monad (liftM, replicateM)
import Data.Array (Array, (!), array, bounds)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Array (Int, Int) Bool -> Int
solve array
  | any (array !) [(1,j) | j <- [1..m]]  =  2
  | any (array !) [(i,1) | i <- [1..n]]  =  2
  | any (array !) [(n,j) | j <- [1..m]]  =  2
  | any (array !) [(i,m) | i <- [1..n]]  =  2
  | otherwise  =  4
  where
    (n, m)  =  snd $ bounds array

main :: IO ()
main  =  do
    [n, m]  <-  reads
    xss  <-  replicateM n reads
    let array  =  Data.Array.array ((1,1), (n,m)) $ map (\(i, x) -> ((i `div` m + 1, i `mod` m + 1), x == 1)) $ zip [0..] $ concat xss
    print $ solve array
  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

module Main where
import Control.Applicative
import Data.List
import qualified Data.Map as Map
main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  -- _ <- getLine
  l1:board <- lines <$> getContents
  if '1' `elem` (l1 ++ head (reverse board) ++ concatMap (\(x:xs) -> [x, head $ reverse xs]) board)
    then print 2
    else print 4

module Main where
import Control.Applicative
import Data.List
import qualified Data.Map as Map
main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  -- _ <- getLine
  board <- map ((==1) . read) . words . intercalate " " . lines <$> getContents :: IO [Bool]
  let doit candoit (b,i) =
        candoit || (b && ((row `elem` [0,n-1]) || (col `elem` [0,m-1])))
        where row = i `div` n
              col = i `mod` n
      can = foldl doit False $ zip board [0..]
  -- print $ map (\i -> (i `div` n, i`mod`n)) [0..n*m]
  print (if can then 2 else 4)
  -- cs <- map read . words <$> getLine :: IO [Int]
  -- [x,y] <- map read . words <$> getLine :: IO [Int]
  -- let beginnerSizes = scanl1 (+) cs
  --     numKids = sum cs
  --     intermediateSizes = map (numKids -) beginnerSizes
  -- print (case find (\(bSize,iSize,_) ->
  --                     x <= bSize && bSize <= y && x <= iSize && iSize <= y) $
  --             zip3 beginnerSizes intermediateSizes ([1..] :: [Int]) of
  --          Just (_,_,a) -> a + 1
  --          Nothing -> 0)


{-# LANGUAGE BangPatterns #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad.Trans.State.Strict
import qualified Data.ByteString.Char8            as B
import           Data.Char
import           Data.Int
import qualified Data.List                        as L

main :: IO ()
main = do
    [n, _m] <- map read.words <$> getLine
    xds <- map (fromIntegral *** fromIntegral).L.unfoldr (runStateT parseInt2) <$> B.getContents
    print $ solve n xds

solve :: Int64 -> [(Int64, Int64)] -> Double
solve n xds = (fromIntegral . sum $ map diff ds) / fromIntegral n + fromIntegral (sum xs)
  where
    !up = sum[1..n-1]
    !down | odd n = 2 * sum[1..div n 2]
          | otherwise = 2 * sum[1..div n 2] - div n 2

    (xs, ds) = unzip xds
    diff d
        | d > 0 = d * up
        | d == 0 = 0
        | otherwise = d * down

type Parser a = StateT B.ByteString Maybe a

parseInt :: Parser Int
parseInt = StateT $ B.readInt . B.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = (,) <$> parseInt <*> parseInt

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = (,,) <$> parseInt <*> parseInt <*> parseInt

import Data.List

toint s = (read s) :: Integer

g n = div (n * (n+1)) 2

f::Integer->Integer->Integer
f d n =
    if d > 0 then
        d * (div (n*(n-1)) 2)
    else
        if mod n 2 == 1 then
            d * ((div n 2) * ((div n 2) + 1))
        else
            d * ((g (div n 2)) + (g ((div n 2) - 1)))

doit [] n r = r
doit (x:d:xs) n r =
    doit xs n (r+x*n+(f d n))

solve::String -> String
solve sss =
    let (n:m:s) = map toint $ words sss in
    let r = doit s n 0 in
    (show (((fromInteger r)::Double) / ((fromInteger n)::Double))) ++ "\n"

main = do
  interact $ solve


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

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

readInt = fst . M.fromJust . C.readInt

main = do
    (readInt -> n) <- B.getLine
    (map snd . L.sort . (flip zip) [1..] . map readInt . C.words -> xs) <- B.getLine
    (C.unpack -> p) <- B.getLine
    let f ('0':ps) (x:xs) ys rs = f ps xs (x:ys) (x:rs)
        f ('1':ps) xs (y:ys) rs = f ps xs ys (y:rs)
        f _ _ _ rs = reverse rs
    putStrLn . unwords . map show $ f p xs [] []

{-# LANGUAGE ViewPatterns #-}
module Main where
import Control.Monad
import Data.List
import qualified Data.IntMap.Strict as M

main = getLine >> liftM2 solve (fmap (fmap read . words) getLine) (fmap (map (== '0')) getLine) >>= putStr . unwords . map show

solve ws = snd . mapAccumL (flip go) (M.fromList $ zip ws [(1 :: Int)..], M.empty)
  where
  go False (e, M.deleteFindMax -> ((_, i), o)) = ((e, o), i)
  go True (M.deleteFindMin -> (r@(_, i), e), uncurry M.insert r -> o) = ((e, o), i)

import Data.List

solve :: [(Int, Int)] -> [(Int, Int)] -> String -> [Int]
solve [] [] [] = []
solve ((valA, indA) : tailA) b ('0' : tailS) = indA : solve tailA ((valA, indA) : b) tailS
solve a ((valB, indB) : headB) ('1' : tailS) = indB : solve a headB tailS
solve _ _ _ = []

main = do
    s <- getLine
    let n = read s :: Int
    s <- getLine
    let weights = map (read::String->Int) (words s)
    s <- getLine
    let arr = sort $ zip weights [1..]
    let ans = solve arr [] s
    putStrLn $ intercalate " " $ map show ans

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

indexed :: Int -> [a] -> [(a, Int)]
indexed _ [] = []
indexed i (x:xs) = (x, i) : (indexed (succ i) xs)

solve :: String -> [(Int, Int)] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (x:xs) [] (y:ys) = (snd y) : (solve xs [] ys)
solve (x:xs) (y:ys) [] = (snd y) : (solve xs ys (return y))
solve (x:xs) free@(y:ys) taken@(z:zs)
  | x == '0' = (snd y) : (solve xs ys (y : taken))
  | x == '1' = (snd z) : (solve xs free zs)

main :: IO ()
main = do
	[n] <- getInts
	w <- getInts
	s <- getLine
	putStrLn $ intercalate " " $ map show $ solve s (sort (indexed 1 w)) []

module Main (main) where

import Data.List (maximumBy, minimumBy, sortBy)
import qualified Data.Map.Lazy as M
import Data.Map.Lazy (fromList)

getIntegers :: IO [Int]
getIntegers = fmap (map read . words) getLine

-- seatOccupation :: [Bool] -> [(Int, (Int, Int))] -> [Int]
-- seatOccupation [] _ = []
-- seatOccupation (isExtravert:xs) currentSeating =
--   let (n, (weight, taken)) = selectWeight . selectOccupancy $ currentSeating
--         where selectWeight = (if isExtravert then maximumBy else minimumBy)
--                 (\(_, (w, _)) (_, (w', _)) -> compare w w')
--               selectOccupancy = filter (\(_, (_, taken)) ->
--                                           (isExtravert && taken == 1)
--                                           || ((not isExtravert) && taken == 0))
--       newSeating toList . insert n (weight, taken + 1) . fromList $ currentSeating
--   in n : seatOccupation xs newSeating

-- main' :: IO ()
-- main' = do
--   _ <- getLine
--   seatWidths <- getIntegers
--   passengers <- fmap (fmap (== '1')) $ getLine
--   let rows = fmap  (\(n, w) -> (n, (w, 0)))
--         . sortBy (\(_, w) (_, w') -> compare w w')
--         . zip [1..] $ seatWidths
--   mapM_ (\n -> putStr $ show n ++ " ") $ seatOccupation passengers rows

selectSeats :: [Bool] -> Int -> [Int] -> [Int]
selectSeats [] _ _ = []
selectSeats (isExtravert:nextPassengers) nextFreeRow introvertRows =
  if isExtravert then
    let (row:newIntrovertRows) = introvertRows
    in row : selectSeats nextPassengers nextFreeRow newIntrovertRows
  else
    nextFreeRow : selectSeats nextPassengers (nextFreeRow + 1) (nextFreeRow : introvertRows)

main :: IO ()
main = do
  _ <- getLine
  seatWidths <- getIntegers
  passengers <- fmap (fmap (== '1')) getLine
  let rows = map (\(n, _) -> n)
        . sortBy (\(_, w) (_, w') -> compare w w')
        . zip [1..] $ seatWidths
      weightedOrder = selectSeats passengers 1 []
      weightedToOriginal = zip [1..] rows
      restoredOrder = map (\nW ->
                             let (Just n) = M.lookup nW $ M.fromList weightedToOriginal
                             in n) weightedOrder
    in mapM_ (\n -> putStr $ (show n) ++ " ") restoredOrder

module Main (main) where

import Data.List (maximumBy, minimumBy, sortBy)
import Data.Map.Lazy (insert, toList, fromList)

getIntegers :: IO [Int]
getIntegers = fmap (map read . words) getLine

seatOccupation :: [Bool] -> [(Int, (Int, Int))] -> [Int]
seatOccupation [] _ = []
seatOccupation (isExtravert:xs) currentSeating =
  let (n, (weight, taken)) = selectWeight . selectOccupancy $ currentSeating
        where selectWeight = (if isExtravert then maximumBy else minimumBy)
                (\(_, (w, _)) (_, (w', _)) -> compare w w')
              selectOccupancy = filter (\(_, (_, taken)) ->
                                          (isExtravert && taken == 1)
                                          || ((not isExtravert) && taken == 0))
      newSeating = toList . insert n (weight, taken + 1) . fromList $ currentSeating
  in n : seatOccupation xs newSeating

main :: IO ()
main = do
  _ <- getLine
  seatWidths <- getIntegers
  passengers <- fmap (fmap (== '1')) $ getLine
  let rows = fmap  (\(n, w) -> (n, (w, 0)))
        . zip [1..] $ seatWidths
  print $ seatOccupation passengers rows

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

indexed :: Int -> [a] -> [(a, Int)]
indexed _ [] = []
indexed i (x:xs) = (x, i) : (indexed (succ i) xs)

solve :: String -> [(Int, Int)] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (x:xs) [] (y:ys) = (snd y) : (solve xs [] ys)
solve (x:xs) (y:ys) [] = (snd y) : (solve xs ys (return y))
solve (x:xs) free@(y:ys) taken@(z:zs)
  | x == '0' = (snd y) : (solve xs ys (y : taken))
  | x == '1' = (snd z) : (solve xs free zs)

main :: IO ()
main = do
	[n] <- getInts
	w <- getInts
	s <- getLine
	putStrLn $ intersperse ' ' $ concatMap show $ solve s (sort (indexed 1 w)) []


import Control.Monad (replicateM_)
import Data.Int (Int64)

solve :: [Int64] -> Int64
solve li = sum . map (max 0) $ zipWith (-) li (tail li)

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    print (solve a)

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  print $ sum $ map (max 0) $ zipWith (-) as (tail as)

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

readInt64B8 :: B8.ByteString -> Int64
readInt64B8 = fromInteger . fst . fromJust . B8.readInteger

solve :: Int -> [Int64] -> Int64
solve n hs = sum steps
    where
        steps = map (\(x, y) -> max 0 $ x - y) adjacentHs
        adjacentHs = zip hs $ tail hs

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        hs <- map readInt64B8 <$> B8.words <$> B8.getLine
        let answer = solve n hs
        printf "%s\n" $ show answer


module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Graph
import Data.Array.Unboxed
import Data.Int
import Data.Tree

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  cs <- replicateM n poi
  ps <- replicateM m $ liftM2 (,) poi poi
  return $ show $ solve n cs ps
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n cs0 = sum . map (minimum . map (cs!) . flatten) . components . buildG (1, n)
  where cs = listArray (1, n) $ map fromIntegral cs0 :: UArray Int Int64

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

readIntegers :: IO [Integer]
readIntegers = map (fst . fromJust . C.readInteger) <$> C.words <$> C.getLine

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1, n) <$> readIntegers
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ [x | [a, b] <- friends, x <- [(a, b), (b, a)]]
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (amounts!)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1,n) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ map (\[a, b] -> (a, b)) friends
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (\x -> amounts ! x)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (1, n) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (1, n) $ [x | [a, b] <- friends, x <- [(a, b), (b, a)]]
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (amounts!)) xs
    print ans

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Graph
import Data.Array ((!))
import qualified Data.Array as A
import qualified Data.Tree as T

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

main :: IO ()
main = do
    [n, m] <- readInts
    amounts <- A.listArray (0, n) <$> (0:) <$> readInts
    friends <- replicateM m readInts
    let f = dff $ buildG (0, n) $ map (\[a, b] -> (a, b)) friends
    let xs = map T.flatten f
    let ans = sum $ map (minimum . map (\x -> amounts ! x)) xs
    print ans


{-# OPTIONS_GHC -XStrict -XStrictData #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
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 Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

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

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

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

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

getRanges :: Graph -> (UArray Int Int, UArray Int Int)
getRanges g = runST $ do
    s <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    e <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    cur <- newSTRef 1
    let dfs x = do
        i <- readSTRef cur
        writeArray s x i
        modifySTRef' cur (+1)
        forM_ (g!x) dfs
        readSTRef cur >>= \t -> writeArray e i t
    dfs 1
    rs <- unsafeFreezeSTUArray s
    re <- unsafeFreezeSTUArray e
    return (rs, re)

solve :: Graph -> UArray Int Int -> UArray Int Int -> Int
solve g ss ee = dfs IS.empty 0 1
    where
        dfs w r x =
            let s = ss ! x
                e = ee ! s
                a = IS.lookupLT s w
                b = IS.lookupGT s w
                (w',r') =
                    if maybe True (>= e) b then
                        case a of
                            Just a ->
                                if ee ! a > s then
                                    (IS.delete a . IS.insert s $ w, r)
                                else
                                    (IS.insert s w, r+1)
                            Nothing -> (IS.insert s w, r+1)
                    else
                        (w,r)
            in
                maximum $ r' : map (dfs w' r') (g ! x)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        let readG = buildG (1,n) . flip zip [2..] . map parseInt . BS.words <$> BS.getLine
        g1 <- readG
        g2 <- readG
        let (s,e) = getRanges g2
        print $ solve g1 s e

{-# OPTIONS_GHC -XStrict -XStrictData #-}
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
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 Data.Tuple
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

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

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

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

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

getRanges :: Graph -> (UArray Int Int, UArray Int Int)
getRanges g = runST $ do
    s <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    e <- newArray (bounds g) 0 :: ST s (STUArray s Int Int)
    cur <- newSTRef 1
    let dfs x = do
        i <- readSTRef cur
        writeArray s x i
        modifySTRef' cur (+1)
        forM_ (g!x) dfs
        readSTRef cur >>= \t -> writeArray e i t
    dfs 1
    rs <- unsafeFreezeSTUArray s
    re <- unsafeFreezeSTUArray e
    return (rs, re)

solve :: Graph -> UArray Int Int -> UArray Int Int -> Int
solve g ss ee = dfs Set.empty 1
    where
        dfs w x =
            let s = ss ! x
                e = ee ! s
                a = Set.lookupLT s w
                b = Set.lookupGT s w
                w' =
                    if maybe True (>= e) b then
                        case a of
                            Just a ->
                                if ee ! a > s then
                                    Set.delete a . Set.insert s $ w
                                else
                                    Set.insert s w
                            Nothing -> Set.insert s w
                    else
                        w
            in
                maximum $ Set.size w' : map (dfs w') (g ! x)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        let readG = buildG (1,n) . flip zip [2..] . map parseInt . BS.words <$> BS.getLine
        g1 <- readG
        g2 <- readG
        let (s,e) = getRanges g2
        print $ solve g1 s e


import Data.Array.Unboxed
n = 3000
f m=(sum[a!(2*x-z,2*y-w)|(x,y)<-m,(z,w)<-m]-length m)`div`2 where a=accumArray(+)0((-n,-n),(n,n))$zip m$repeat 1::UArray(Int,Int)Int
t[x,y]=(x,y)
main=interact$show.f.map(t.map read.words).tail.lines

import Data.Array.Unboxed
m = 3000
top s = (x, y) where [x, y] = map read $ words s
solve ps = (sum [a ! (2*x-z, 2*y-w) | (x,y) <- ps, (z,w) <- ps] - length ps) `div` 2 where a = accumArray (+) 0 ((-m, -m), (m, m)) (zip ps $ repeat 1) :: UArray (Int, Int) Int
main = print . solve . map top . tail . lines =<< getContents

import Data.Array.Unboxed
n=3000
f m=sum[a!(x+x-z,y+y-w)|p@(x,y)<-m,q@(z,w)<-m,p<q]where a=accumArray(+)0((-n,-n),(n,n))$zip m$repeat 1::UArray(Int,Int)Int
t[x,y]=(x,y)
main=interact$show.f.map(t.map read.words).tail.lines

import Data.Map (Map, fromList, member)

{-
import HUnit

emptyTest :: Test
emptyTest  =  Test "EmptyTest" $
    assertEq 0 (solve [])

inputTest :: Test
inputTest  =  TestList "InputTest"
    [Test "1" $ assertEq 1 (solve [(1,1), (2,2), (3,3)]),
     Test "2" $ assertEq 0 (solve [(0,0), (1,0), (0,1)])]

testFourPoints :: Test
testFourPoints  =  Test "TestFourPoints" $
    assertEq 2 (solve [(-2,-2), (0,0), (2,2), (4,4)])

testSquare :: Test
testSquare  =  TestList "TestSquare"
    [Test "3x3" $ assertEq 8 (solve [(1,1),(1,2),(1,3),
                                   (2,1),(2,2),(2,3),
                                   (3,1),(3,2),(3,3)]),
     Test "4x4" $ assertEq 24 (solve [(i,j) | i <- [1..4], j <- [1..4]])]

bigTest :: Test
bigTest  =  Test "BigTest" $
    assertEq (div (3000 * 3000 - 2 * 3000) 4) (solve [(2*i,2*i) | i <- [1..3000]])

testRectangle :: Test
testRectangle  =  Test "TestRectangle 3x7" $
    assertEq 52 (solve [(i, j) | i <- [1..3], j <- [1..7]])

test :: IO ()
test  =  mapM_ run
    [emptyTest,
     inputTest,
     testFourPoints,
     testSquare,
     bigTest,
     testRectangle]

--------------------------------------------------------------------------------
-}

type Point  =  (Int, Int)
type PointsMap  =  Map Point Bool

getPoint :: IO Point
getPoint  =  do
    line  <-  getLine
    let [x, y]  =  map read $ words line
    return (x, y)

solve :: [Point] -> Int
solve points  =  length [undefined | (x1, y1) <- points, (x2, y2) <- points,
    (x1,y1) < (x2,y2),
    even x1 == even x2,
    even y1 == even y2,
    member (quot (x1 + x2) 2, quot (y1 + y2) 2) pointsMap]
  where
    pointsMap :: PointsMap
    pointsMap  =  fromList [(k, undefined) | k <- points]

main :: IO ()
main  =  do
    n  <-  readLn
    points  <-  mapM (const getPoint) [1..n]
    print $ solve points