import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Maybe

btoi :: (Integral a) => B.ByteString -> a
btoi = fromIntegral . fst . fromJust . B.readInt

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ reverse mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

getRow :: ([Integer] -> Bool) -> [[Integer]] -> [Integer]
getRow p (row:rest)
  | p row     = row
  | otherwise = getRow p rest

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat =
  let row  = getRow (elem 0) mat
      row' = getRow (not . (elem 0)) mat
      t    = sum row' - sum row
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: B.ByteString -> B.ByteString
process str =
  let (header:body) = B.lines str
      n             = btoi header
      mat           = map (map btoi . take n . B.words) $ take n body
  in B.pack . show $ process_case n mat

main :: IO ()
main = B.interact process

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case ans < 1 of
                   True -> print (-1)
                   False -> print ans
        ans = case n of
          1 ->  9 -- doesnt matter
          _ -> case possible && (hdiff == vdiff) of
                 False ->  (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False ->  (-2)
                                               True ->  d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False ->  (-3)
                                                True ->  d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False ->  (-4)
                                                True ->  hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False ->  (-5)
                                                 True ->  hdiff

    action

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  calculate2 :: [[Integer]] -> Int
  calculate2 _ = -1 -- TODO

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case n of
          1 -> print 9 -- doesnt matter
          2 -> print $ calculate2 matrix
          _ -> case possible && (hdiff == vdiff) of
                 False -> print (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False -> print (-1)
                                               True -> print d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False -> print (-1)
                                                True -> print d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False -> print (-1)
                                                True -> print hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False -> print (-1)
                                                 True -> print hdiff

    action

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Integer
  readInt s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  getTotalOnNonZero :: (Bool, [Integer]) -> Integer
  getTotalOnNonZero (True, _) = -1
  getTotalOnNonZero (False, xs) = sum xs

  hasZero :: [Integer] -> Bool
  hasZero = any (==0)

  main :: IO()
  main = do
    n <- getLine >>= return . (read :: String -> Int)
    matrix <- readMultilineInput n (return . (map readInt) . words)
    let matrixT = transpose matrix
        zeroX = 0 -- TODO
        zeroY = 0 -- TODO
        lm = length matrix
        zerosH = map hasZero matrix
        zerosV = map hasZero matrixT
        ids = [0..(length matrix - 1)]
        diags = (\index -> matrix !! index !! index) `map` ids
        diagsI = (\index -> matrix !! index !! (lm - index - 1)) `map` ids
        sdiags = sum diags
        sdiagsI = sum diagsI
        hm = zerosH `zip` matrix
        vm = zerosV `zip` matrixT
        hmm = snd . head $ filter fst hm :: [Integer]
        vmm = snd . head $ filter fst vm :: [Integer]
        horizontals = map getTotalOnNonZero hm
        verticals = map getTotalOnNonZero vm
        targetScore = head $ filter (>=0) horizontals
        allTargets = filter (>0) $ horizontals ++ verticals
        possible = all (==targetScore) allTargets
        shmm = sum hmm
        svmm = sum vmm
        d1diff = targetScore - sdiags
        d2diff = targetScore - sdiagsI
        hdiff = targetScore - shmm
        vdiff = targetScore - svmm
        action = case n of
          1 -> print 9 -- doesnt matter
          _ -> case possible && (hdiff == vdiff) of
                 False -> print (-1)
                 True -> case any (==0) diags of
                           True -> case any (==0) diagsI of
                                     True -> case d1diff == d2diff && hdiff == d1diff of
                                               False -> print (-1)
                                               True -> print d1diff
                                     False -> case d1diff == hdiff && sdiagsI == targetScore of
                                                False -> print (-1)
                                                True -> print d1diff
                           False -> case any (==0) diagsI of
                                      True -> case hdiff == d2diff && sdiags == targetScore of
                                                False -> print (-1)
                                                True -> print hdiff
                                      False -> case sdiagsI == sdiags && sdiags == targetScore of
                                                 False -> print (-1)
                                                 True -> print hdiff

    action

import Data.List

replace :: Integer -> Integer -> [[Integer]] -> [[Integer]]
replace _ _ []         = []
replace a b (row:rest) = (replace' row):replace a b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | a == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in length (nub (rows ++ cols ++ [diag1, diag2])) == 1

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat@(row:row':_) =
  let s = if elem 0 row then sum row' else sum row
      t = if elem 0 row then sum row' - sum row else sum row - sum row'
      mat' = replace 0 t mat
  in if checkMagic mat' && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process

import Data.List

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

getRow :: ([Integer] -> Bool) -> [[Integer]] -> [Integer]
getRow p (row:rest)
  | p row     = row
  | otherwise = getRow p rest

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat =
  let row  = getRow (elem 0) mat
      row' = getRow (not . (elem 0)) mat
      t    = sum row' - sum row
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process

import Data.List

replace :: Integer -> [[Integer]] -> [[Integer]]
replace _ []         = []
replace b (row:rest) = (replace' row):replace b rest
  where
    replace' :: [Integer] -> [Integer]
    replace' []   = []
    replace' (x:xs)
      | 0 == x    = b:xs
      | otherwise = x:replace' xs

getDiag :: [[Integer]] -> [Integer]
getDiag [] = []
getDiag ((r:row):rest) = r : getDiag (map tail rest)

allEq :: [Integer] -> Bool
allEq []     = True
allEq (x:xs) = all (== x) xs

checkMagic :: [[Integer]] -> Bool
checkMagic mat =
  let rows  = map sum mat
      cols  = map sum $ transpose mat
      diag1 = sum $ getDiag mat
      diag2 = sum . getDiag $ transpose mat
  in allEq $ rows ++ cols ++ [diag1, diag2]

process_case :: Int -> [[Integer]] -> Integer
process_case 1 _              = 1
process_case _ mat@(row:row':_) =
  let s = if elem 0 row then sum row' else sum row
      t = if elem 0 row then sum row' - sum row else sum row - sum row'
      mat' = replace t mat
  in if checkMagic mat' && t > 0 && t <= 10^18 then t else -1

process :: String -> String
process str =
  let (header:body) = lines str
      n             = read header
      mat           = map (map read . take n . words) $ take n body
  in show $ process_case n mat

main :: IO ()
main = interact process


{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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

testCase :: Scanner String
testCase = do
  n <- int
  m <- int
  edges <- m >< pair int int
  q <- int
  qs <- q >< query
  return . unlines . map show $ solve n edges qs

data Query = Add Int Int | Rem Int Int | Ask deriving (Eq, Show)

query :: Scanner Query
query = do
  t <- int
  case t of
    1 -> Add <$> int <*> int
    2 -> Rem <$> int <*> int
    3 -> pure Ask

solve :: Int -> [(Int, Int)] -> [Query] -> [Int]
solve n edges qs = runST compute
  where
    init :: UArray Int Int
    init = accumArray (+) 0 (1, n) [(min u v, 1) | (u, v) <- edges]

    initAns :: Int
    initAns = length . filter (== 0) $ elems init

    compute :: forall s. ST s [Int]
    compute = do
      (better :: STUArray s Int Int) <- thaw init
      deltas <- forM qs $ \case
        Add u v -> do
          let x = min u v
          d <- readArray better x
          writeArray better x (d + 1)
          return $ if d == 0 then (-1) else 0
        Rem u v -> do
          let x = min u v
          d <- readArray better x
          writeArray better x (d - 1)
          return $ if d == 1 then 1 else 0
        Ask -> return 0
      let values = tail $ scanl1 (+) (initAns : deltas)
      return [v | (q, v) <- zip qs values, case q of Ask -> True; _ -> False]

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Data.Array.IO.Safe
import qualified Data.IntSet as S
import Data.Maybe

modifyAt :: IOArray Int t -> Int -> (t -> t) -> IO ()
modifyAt arr ix fun = do
  val <- readArray arr ix
  let  nval = fun val
  nval `seq` writeArray arr ix nval

insE :: IOArray Int S.IntSet -> Int -> Int -> SIO ()
insE arr u v = lift $ do
  modifyAt arr u $ S.insert v
  modifyAt arr v $ S.insert u

remE :: IOArray Int S.IntSet -> Int -> Int -> SIO ()
remE arr u v = lift $ do
  modifyAt arr u $ S.delete v
  modifyAt arr v $ S.delete u

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  arr <- lift $ newArray (1, n) S.empty :: SIO (IOArray Int S.IntSet)
  replicateM_ m $ do
    [u, v] <- readInts
    insE arr u v
  let
    isVuln :: Int -> SIO Bool
    isVuln i = lift $ isJust . S.lookupGT i <$> readArray arr i
  ivulns <- fmap S.fromAscList $ filterM isVuln [1..n]
  let
    insv (vulns, ct) u = (
      S.insert u vulns,
      ct + if  S.notMember u vulns  then  1  else  0
      )
    remv (vulns, ct) u = (
      S.delete u vulns,
      ct - if  S.member u vulns  then  1  else  0
      )
  [q] <- readInts
  (\fun -> foldM_ fun (ivulns, S.size ivulns) [1..q]) $ \(vulns, ct) _ -> do
    qt : pars <- readInts
    case  (qt, pars)  of
      (1, [u, v]) -> do
        insE arr u v
        uv <- isVuln u
        vv <- isVuln v
        let  (v1, c1) = if  uv  then  insv (vulns, ct) u  else  (vulns, ct)
        pure $ if  vv  then  insv (v1, c1) v  else  (v1, c1)
      (2, [u, v]) -> do
        remE arr u v
        uv <- isVuln u
        vv <- isVuln v
        let  (v1, c1) = if  not uv  then  remv (vulns, ct) u  else  (vulns, ct)
        pure $ if  not vv  then  remv (v1, c1) v  else  (v1, c1)
      (3, []) -> (vulns, ct) <$ putInts [n - ct]
      _ -> error "bad input"

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 Data.List
main=interact$show.length.group.sort.f.tail.lines
f("**":s)=f s
f([a,b]:[c,d]:s)=minimum[[a,b,d,c],[b,d,c,a],[d,c,a,b],[c,a,b,d]]:f s
f _=[]

import Control.Monad
import Data.List

main = do
	n <- fmap read getLine
	a <- replicateM (3*n-1) getLine
	putStrLn $ show $ length $ group $ sort $ gao a where
		gao [] = []
		gao (a:b:s) = c: gao (drop 1 s) where
			c = minimum $ take 4 $ iterate (\(h:t) -> t ++ [h]) $ a ++ reverse b

import List
import Control.Monad

main = do
  n  <- readLn
  d  <- getDice
  ds <- replicateM (n-1) $ getLine>>getDice
  print $ solve (d:ds)

getDice = do
  xs <- getLine
  ys <- getLine
  return $ xs ++ reverse ys

solve ds = length$group$sort[sort[rotateL n d| n<-[0..3]]| d<-ds]

rotateL n xs = drop n xs ++ take n xs

module Main where

import Control.Monad    -- replicateM, mapM, etc.
import Data.Int         -- Int, Int64, etc.
import Data.List        -- sort, find, etc.
import Data.Array       -- listArray, array, etc.
import Debug.Trace      -- trace

readI :: String -> Int
readI = read

readL :: String -> [Int]
readL = (map read) . words

main = do
    n <- getLine >>= return . readI
    ds <- replicateM (3*n-1) getLine
    print $ solve ds

solve ds = length $ nubBy isEq xs where

    xs = glue $ filter (/="**") ds
    glue xs = glue' xs [] where
        glue' []       acc = acc
        glue' (x:y:xs) acc = glue' xs ((x ++ y):acc)

    isEq [c1,c2,c3,c4] [a1,a2,a3,a4] =
        (c1==a1 && c2==a2 && c3==a3 && c4==a4) ||
        (c1==a2 && c2==a4 && c3==a1 && c4==a3) ||
        (c1==a3 && c2==a1 && c3==a4 && c4==a2) ||
        (c1==a4 && c2==a3 && c3==a2 && c4==a1)

import Control.Monad (liftM2, replicateM)
import List (nub)

data Eq a => T a  =  T [a]

instance Eq a => Eq (T a)
  where
    (==) (T as) (T bs)  =  elem as $ rotations bs

rotations :: [a] -> [[a]]
rotations xs  =  take n . map (take n) . iterate tail . cycle $ xs
  where
    n  =  length xs

parse :: String -> String -> T Char
parse [c1, c2] [c3, c4]  =  T [c1, c2, c4, c3]

getT :: IO (T Char)
getT  =  liftM2 parse (while (== "**") getLine) getLine

solve :: [T Char] -> Int
solve  =  length . nub

while :: Monad m => (a -> Bool) -> m a -> m a
while f ma  =  do
    a  <-  ma
    if f a
        then while f ma
        else return a

main :: IO ()
main  =  readLn >>= flip replicateM getT >>= print . solve

import Data.Set
main = interact solve
solve input = show $ size $ f $ lines input
f [] = empty
f (x:y:z:xs) = insert (minimum $ take 4 $ iterate g (y ++ reverse z)) (f xs)
g (x:xs) = xs ++ [x]

import Data.List
main=interact$show.length.group.sort.f.tail.lines
f([a,b]:[c,d]:_:s)=minimum[[a,b,d,c],[b,d,c,a],[d,c,a,b],[c,a,b,d]]:f s
f _=[]


{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Integer -> [(Integer, Integer)] -> Integer
main' powder recIng = findMax (0, max' + powder) recIng powder
  where max' = sum $ map snd recIng

findMax :: (Integer, Integer) -> [(Integer, Integer)] -> Integer -> Integer
findMax (start, end) recIng powder
  | (start == end - 1) && canCookMid && (not canCookMid') = start
  | (start == end - 1) && canCookMid && canCookMid' = end
  | start == end = end
  | canCookMid = findMax (mid, end) recIng powder
  | otherwise = findMax (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    canCookMid = canCookN mid recIng powder
    canCookMid' = canCookN (mid + 1) recIng powder

canCookN :: Integer -> [(Integer, Integer)] -> Integer -> Bool
canCookN n recInt powder
  | n == 0 = True
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Integer -> [(Integer, Integer)] -> Integer
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Integer, Integer) -> [(Integer, Integer)] -> Integer -> Integer
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Integer -> [(Integer, Integer)] -> Integer -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

readInt = fromIntegral . fst . fromJust . BS8.readInteger

readIntsLine = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

readLine = BS8.getLine >>= return . map readInt . BS8.words

-- can cook more if powder > then sum of all missing ingridients
canCook need has powder x = (powder >=) . sum . filter ( > 0 ) . map (\(need, has) -> need * x - has) $ zip need has

cook _canCook from to limit
  | to > limit = cook _canCook from limit limit -- limit yourself
  | from == to && _canCook to = to
  | from == to && not (_canCook to) = 0  -- can't cook anything
  | to - from == 1 && _canCook to = to
  | from == cookies && _canCook cookies = cookies -- found answer
  | _canCook cookies = cook _canCook cookies (cookies * 2) limit -- can cook more so search
  | otherwise = cook _canCook from cookies limit -- search on the left
  where cookies = (from + to) `quot` 2

main = do
   [_, powder] <- readLine
   need <- readLine
   has <- readLine
   let maxCookies = (sum has + powder + 1) `quot` sum need
   print $ cook (canCook need has powder) 1 4 maxCookies

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . filter (> 0) . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, magicPowder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       -- always possible to bake zero
       0
       -- never possible to bake more than maximum in stock plus all magic powder
       -- even if we need only one gram per cookie
       (maximum stock + magicPowder + 1)

-- priority queue

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . filter (> 0) . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

main = do
  [ingrNumber, magicPowder] <- B.getLine >>= return . map readInt . B.words
  recipe <- B.getLine >>= return . map readInt . B.words
  stock <- B.getLine >>= return . map readInt . B.words
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       -- always possible to bake zero
       0
       -- never possible to bake more than maximum in stock plus all magic powder
       -- even if we need only one gram per cookie
       (maximum stock + magicPowder + 1)

module Main where

import Data.Maybe (fromJust)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

readInt = fromIntegral . fst . fromJust . BS8.readInteger

readIntsLine = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

readLine = BS8.getLine >>= return . map readInt . BS8.words

-- can cook more if powder > then sum of all missing ingridients
canCook need has powder x = (powder >=) . sum . filter ( > 0 ) . map (\(need, has) -> need * x - has) $ zip need has

cook _canCook from to limit
  | to > limit = cook _canCook from limit limit -- limit yourself
  | from == to = 0 -- can't cook anything
  | to - from == 1 && _canCook to = to
  | from == cookies && _canCook cookies = cookies -- found answer
  | _canCook cookies = cook _canCook cookies (cookies * 2) limit -- can cook more so search
  | otherwise = cook _canCook from cookies limit -- search on the left
  where cookies = (from + to) `quot` 2

main = do
   [_, powder] <- readLine
   need <- readLine
   has <- readLine
   let maxCookies = (sum has + powder + 1) `quot` sum need
   print $ cook (canCook need has powder) 1 4 maxCookies

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMax (0, max' + powder) recIng powder
  where max' = sum $ map snd recIng

findMax :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMax (start, end) recIng powder
  | (start == end - 1) && canCookMid && (not canCookMid') = start
  | (start == end - 1) && canCookMid && canCookMid' = end
  | start == end = end
  | canCookMid = findMax (mid, end) recIng powder
  | otherwise = findMax (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    canCookMid = canCookN mid recIng powder
    canCookMid' = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | n == 0 = True
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `div` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

{-
Find max x + y + z such as, a * x + b * y + c * z = n
For given a, b, c and n
-}
module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, 2 * 10^9) recIng powder

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook (0, max' + powder) recIng powder
  where max' = foldr (\(_, y) agg -> agg + y ) 0 recIng

findMaxCook :: (Int, Int) -> [(Int, Int)] -> Int -> Int
findMaxCook (start, end) recIng powder
  -- | and [not ccN, n' == 1] = base
  | ccEnd = end
  | and [ccN, not ccN1] = mid
  | ccN = findMaxCook (mid, end) recIng powder
  | otherwise = findMaxCook (start, mid) recIng powder
  where
    mid = start + ((end - start) `quot` 2)
    ccN = canCookN mid recIng powder
    ccEnd = canCookN end recIng powder
    ccN1 = canCookN (mid + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

module Main where

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_, powder] <- readLine
  recipe <- readLine
  stock <- readLine
  B.putStrLn . B.pack . show $ 1000000000-- main' powder $ zip recipe stock

main' :: Int -> [(Int, Int)] -> Int
main' powder recIng = findMaxCook 1 0 recIng powder

findMaxCook :: Int -> Int -> [(Int, Int)] -> Int -> Int
findMaxCook n base recIng powder
  | and [not ccN, n' == 1] = base
  | and [ccN, not ccN1] = n'
  | ccN = findMaxCook (n * 2) base recIng powder
  | otherwise = findMaxCook 1 (base + (n `div` 2)) recIng powder
  where
    n' = n + base
    ccN = canCookN n' recIng powder
    ccN1 = canCookN (n' + 1) recIng powder

canCookN :: Int -> [(Int, Int)] -> Int -> Bool
canCookN n recInt powder
  | powderLeft < 0 = False
  | otherwise = True
  where
    powderLeft = foldr addIngridient powder recInt
    addIngridient (r, i) left
      | left < 0 = left
      | r * n < i = left
      | otherwise = left - r * n + i

-- priority queue

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

prove magicPowder recipe stock n =
  (magicPowder >=) . sum . map (\(r,s) -> r * n - s) $ zip recipe stock

bs f l h =
  let
    middle = quot (h - l) 2 + l
  in
    if middle == l then
      middle
    else
      if f middle then
        bs f middle h
      else
        bs f l middle

main = do
  [ingrNumber, magicPowder] <- B.getLine >>= return . map readInt . B.words
  recipe <- B.getLine >>= return . map readInt . B.words
  stock <- B.getLine >>= return . map readInt . B.words
  B.putStrLn . B.pack . show $
    bs (prove magicPowder recipe stock)
       0
       (maximum stock + magicPowder + 1)


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I

{-
import Data.IntMultiSet (IntMultiSet)
import qualified Data.IntMultiSet as I

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersI :: IntMultiSet -> [Int] -> [Int]
beersI !prices !coins = map (\c -> I.size (I.filter (<=c) prices)) coins

mainI :: IO ()
mainI = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersI (I.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)
 -}

{- prefix sums of sorted int list -}
prefixSum :: [Int] -> IntMap Int
prefixSum xs0 = go xs0 0 0 I.empty
  where
    go !xs y i ps =
      case xs of
        [] -> (I.insert y i ps)
        x:xs' | x <= y -> go xs' y (i+1) ps
              | otherwise -> go xs (y+1) i (I.insert y i ps)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

mainIM :: IO ()
mainIM = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  let ps = prefixSum (sort prices)
  mapM_ (\c -> print (I.findWithDefault (length prices) c ps)) coins

main = mainIM

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

-- for codeforces
import Data.Ord
sortOn f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

type I = Int

main :: IO ()
main = do
  n <- readi <$> getLine
  xs <- map readi . words <$> getLine
  q <- readi <$> getLine
  ms <- map readi <$> replicateM q getLine
  mapM_ print $ fst . unzip . sortOn snd $ solve (sortOn fst $ zip ms [1..]) (sort xs) 0

solve :: [(I, I)] -> [I] -> I -> [(I, I)]
solve [] _ _ = []
solve ((q, p):qs) xs n =
  (n', p) : solve qs (dropWhile (<= q) xs) n' where
    n' = n + length (takeWhile (<= q) xs)

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

readi :: String -> I
readi = read

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] = (x, y, z)

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

main = do
		getLine
		n<-  sort <$> map read <$> words <$> getLine ::IO [Int]
		let m = M.fromAscList $ zip n [1..]
		getLine
		q<- map read <$> words <$> getContents :: IO [Int]
		mapM_ print $ map (\z-> snd (fromMaybe (0,0)  (M.lookupLE z m))) q

{-# OPTIONS -XBangPatterns #-}
import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search !l !r !e
			|a!l > e || l==r = l-1
			|r-l == 1 = l
			|otherwise =
				let m = (l+r) `div` 2
				in if e < a!m
						then binary_search l m e
						else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if a!(ans+1) <= x
			then print $ ans+1
			else print ans

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e
			|a!l > e || l==r = l-1
			|r-l == 1 = l
			|otherwise =
				let m = (l+r) `div` 2
				in if e < a!m
						then binary_search l m e
						else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if a!(ans+1) <= x
			then print $ ans+1
			else print ans

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  xs <- readInts
  [q] <- readInts
  ms <- replicateM q (readInt' <$> getLine)

  let
    a = listArray (1, n) $ sort xs :: UArray Int Int

    count x = search 1 n
      where
        search l r
          | l >= r = if v<= x then l else 0
          | x >= v = search m r
          | x < v = search l (m-1)
          where
            m = (l+r+1)`div`2
            v = a!m

  putStr $ unlines $ map show $ map count ms

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = forM [1..3] (return C.getLine)>>= (\(a:bs:c:[]) ->solve.([map rIn $ C.words bs] ++).(\ls->[ls])=<<forM [1..rIn c] (\i->rIn<$>C.getLine) )
solve [xs,ys]= let ma_x = maximum xs; zs = zip [1..] $ uncurry (zipWith (\(a1,a2) (b1,b2)->(a1,(a2,b2)))) $ (id&&&tail)  $ scanl (\(b1,b2) (a1,a2)->(b1+a1,a2) ) (0,0)  $ map (length&&&head) $ group $ sort xs; ms = Map.fromList zs; len = length zs; tre=tre_e ((Map.!) ms) (1,len); len2= length xs in forM_ ys $ \i-> if i>=ma_x then print len2 else print $ slv1 i tre
tre_e f (x,y) = unfoldTree g (x,y)
     where g (a,b) = let z= (a+)$ div (b-a) 2 in if a>=b then (f a, []) else if a/=z then (f z, [(a,z-1),(z+1,b)]) else (f z, [(z+1,b)])
slv1 n (Node (x,(y,z)) ts) = if n>=y&&n<z then x else if n>=z then slv1 n (last ts) else slv1 n (head ts)

import Data.Array
import Data.List
import Control.Monad
main = do
  n <- readLn
  ps <- listArray (0,n) . (0 :) . sort . map read . words <$> getLine
  let bsearch g = go 0 n where
        go a b | a >= b = b
               | g >= v = go m b
               | otherwise = go a (m-1)
          where m = (a + b + 1) `div` 2
                v = ps!m :: Int
  q <- readLn
  replicateM_ q $ print . bsearch =<< readLn

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e =
		if r-l <= 1
			then l
			else
				let
					m = (l+r) `div` 2
					val = a!m
				in if e <= val
					then binary_search l m e
					else binary_search m r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 (n-1) x
		if (a!ans > x) then print $ ans-1
		else if (a!(ans+1) <= x) then print $ ans+1
		else print ans

import Data.List (sort)
import Data.Array.Unboxed
main = do
	n <- readLn :: IO Int
	a <- fmap (listArray (1,n) . sort . ((map read) . words)) getLine :: IO (UArray Int Int)
	q <- readLn :: IO Int

	let binary_search l r e =
		if l>=r
			then l
			else
				let
					m = (l+r) `div` 2
					val = a!m
				in if val == e
					then m
					else if e < val
							then binary_search l m e
							else binary_search (m+1) r e

	flip mapM [1..q] $ \i -> do
		x <- readLn :: IO Int
		let ans = binary_search 1 n x
		if (a!ans > x)
			then print $ ans-1
			else print ans

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = forM [1..3] (return C.getLine)>>= (\(a:bs:c:[]) ->solve.([map rIn $ C.words bs] ++).(\ls->[ls])=<<forM [1..rIn c] (\i->rIn<$>C.getLine) )
solve [xs,ys]= let ma_x = maximum xs; zs = zip [1..] $ uncurry (zipWith (\(a1,a2) (b1,b2)->(a1,(a2,b2)))) $ (id&&&tail)  $ scanl (\(b1,b2) (a1,a2)->(b1+a1,a2) ) (0,0)  $ map (length&&&head) $ group $ sort xs; ms = Map.fromList zs; len = length zs; tre=tre_e ((Map.!) ms) (1,len) in forM_ ys $ \i-> if i>=ma_x then print len else print $ slv1 i tre
tre_e f (x,y) = unfoldTree g (x,y)
     where g (a,b) = let z= (a+)$ div (b-a) 2 in if a>=b then (f a, []) else if a/=z then (f z, [(a,z-1),(z+1,b)]) else (f z, [(z+1,b)])
slv1 n (Node (x,(y,z)) ts) = if n>=y&&n<z then x else if n>=z then slv1 n (last ts) else slv1 n (head ts)

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I

{-
import Data.IntMultiSet (IntMultiSet)
import qualified Data.IntMultiSet as I

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersI :: IntMultiSet -> [Int] -> [Int]
beersI !prices !coins = map (\c -> I.size (I.filter (<=c) prices)) coins

mainI :: IO ()
mainI = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersI (I.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)
 -}

{- prefix sums of sorted int list -}
prefixSum :: [Int] -> IntMap Int
prefixSum xs0 = go xs0 0 0 I.empty
  where
    go !xs y i ps =
      case xs of
        [] -> (I.insert y i ps)
        x:xs' | x <= y -> go xs' y (i+1) ps
              | otherwise -> go xs (y+1) i (I.insert y i ps)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

mainIM :: IO ()
mainIM = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  let ps = prefixSum (sort prices)
  mapM_ (\c -> print (I.findWithDefault 0 c ps)) coins

main = mainIM

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM, mapM_)
import Data.List (sort)
import Data.Functor ((<$>))

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

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

parseInt :: Text -> Int
parseInt !t =
  case T.decimal t of
    Left _ -> error "wtf"
    Right (x, _) -> x

beersS :: Set Int -> [Int] -> [Int]
beersS !prices !coins = map (\c -> S.size (S.filter (<=c) prices)) coins

main :: IO ()
main = do
  n <- parseInt <$> T.getLine
  prices <- map parseInt . T.splitOn " " <$> T.getLine
  q <- parseInt <$> T.getLine
  coins <- replicateM q (parseInt <$> T.getLine)
  mapM_ print (beersS (S.fromList prices) coins)
  --mapM_ print (beers (sort prices) coins)

beers :: [Int] -> [Int] -> [Int]
beers !prices !coins = map (\c -> length (takeWhile (<=c) prices)) coins

parseIntS :: String-> Int
parseIntS !s = read s

splitS :: String -> [String]
splitS !s0 = splitH s0 "" where
  splitH !cs !ds =
    case cs of
      "" -> if null ds then [] else [reverse ds]
      ' ':cs' -> if null ds then splitH cs' ds else reverse ds : splitH cs' ""
      c:cs' -> splitH cs' (c:ds)

mainS :: IO ()
mainS = do
  n <- parseIntS <$> getLine
  prices <- map parseIntS . splitS <$> getLine
  q <- parseIntS <$> getLine
  coins <- replicateM q (parseIntS <$> getLine)
  mapM_ print (beers (sort prices) coins)

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

-- for codeforces
import Data.Ord
sortOn f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

type I = Int

main :: IO ()
main = do
  n <- readi <$> getLine
  xs <- map readi . words <$> getLine
  q <- readi <$> getLine
  ms <- map readi <$> replicateM q getLine
  print $ fst . unzip . sortOn snd $ solve (sortOn fst $ zip ms [1..]) (sort xs) 0

solve :: [(I, I)] -> [I] -> I -> [(I, I)]
solve [] _ _ = []
solve ((q, p):qs) xs n =
  (n', p) : solve qs (dropWhile (<= q) xs) n' where
    n' = n + length (takeWhile (<= q) xs)

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

readi :: String -> I
readi = read

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] = (x, y, z)


import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printList $ map (map (n-) . reverse . take n . operations . (2^)) [0..k-1]

operations k = replicate k 0 ++ [0..k+1] ++ repeat k

printList = putStrLn . concat . intersperse " " . map show

import Data.Bits

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let ans = [take n $ (0:) $ cycle $ replicate b 0 ++ replicate b b |
        b <- map (2^) [0 .. m - 1]]
  putStr $ unlines $ [unwords $ reverse $ map (show . (n-)) i | i <- ans]

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

getLine' :: Int -> Int -> [Int]
getLine' n i  =  reverse $ take n $ concat
    [
      [n],
      replicate (2^(i-1)) n,
      [n-1, n-2 .. n-2^(i-1)],
      repeat (n-2^(i-1))
    ]

main :: IO ()
main  =  do
    [n, k]  <-  reads
    mapM_ (prints . getLine' n) [1..k]

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    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' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

l=map(\n->0:replicate(2^n)0++[1..2^n]++repeat(2^n))[0..]
s[n,k]=map(map(n-))$map reverse$take k(map(take n)l)
main=interact$unlines.map(unwords.map show).s.map read.words

import Data.Bits

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let ans = [[if (i == 2 * b || (i /= b && j)) then b else 0 | (i, j) <- zip [0 ..] d] |
        b <- map (2^) [0 .. m - 1],
        let d = take n $ cycle $ replicate b False ++ replicate b True]
  putStr $ unlines $ [unwords $ reverse $ map (show . (n-)) i | i <- ans]

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations 3 2)):(map (\k -> operations (1 `shiftL` k) k) [2..])

operations mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = k
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations' 3 2)):(map (\k -> operations $ 1 `shiftL` k) [2..])

operations k = operations' k k

operations' mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = k
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations' 3 2)):(map (\k -> operations $ 1 `shiftL` k) [2..])

operations k = operations' k k

operations' mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | x .&. (k - 1) == 0 = x
                | x .&. mask == mask = k
                | otherwise          = 0

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2] ++ (drop 4 $ operations 3 2)):(map (\k -> operations (1 `shiftL` k) k) [2..])

operations mask k = map getCi [0..]
    where
        getCi x | x <= mask          = 0
                | isPowerOfTwo x     = x
                | x .&. mask == mask = mask
                | otherwise          = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,2,2] ++ (concat $ repeat [0,0,2,0])):(map operations [2..])

operations k = map getCi [0..]
    where
        bit = 1 `shiftL` k
        getCi x | x <= bit         = 0
                | isPowerOfTwo x   = x
                | x .&. bit == bit = bit
                | otherwise        = 0

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show

import Data.Bits ((.&.), shiftL)
import Data.List (intersperse)
import Control.Applicative ((<$>))

main = do
    [n, k] <- map read . words <$> getLine
    mapM_ printOps $ map (buildOps n) $ take k solve

solve = ((0:) $ concat $ repeat [0,1]):([0,0,0,1,2] ++ (concat $ repeat [0,0,1,0])):(map operations [2..])

operations k = map getCi [0..]
    where
        bit = 1 `shiftL` k
        getCi x | x <= bit         = 0
                | isPowerOfTwo x   = x
                | x .&. bit == bit = bit

isPowerOfTwo 0 = False
isPowerOfTwo 1 = True
isPowerOfTwo x = x .&. 1 == 0 && isPowerOfTwo (x `div` 2)

buildOps n = reverse . map (n -) . take n

printOps = putStrLn . concat . intersperse " " . map show


import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let arrayN = (2^(n+1)-2)
  let lights = array (1, arrayN) $ zip [1..arrayN] (readLights firstLine)
  let tree = buildTree 1 (arrayN `div` 2) lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  --putStrLn (show maxLight)
  --putStrLn (show tree)
  putStrLn (show x)

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

buildTree :: Int -> Int -> Array Int Int -> Tree
buildTree n max lights =
  if n > max
    then Leaf
    else let
      lTree = buildTree (2*n) max lights
      rTree = buildTree (2*n + 1) max lights
    in
      Node (lights ! (2*n-1)) (lights ! (2*n)) lTree rTree

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
    x = (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)
  in
    --trace ("ln: " ++ (show ln) ++ " -> " ++ (show ln') ++ " rn: " ++ (show rn) ++ " -> " ++ (show rn')) x
    x

import Data.Bits(shiftL)
import Control.Monad

main = do
    n <- readInt `fmap` getLine
    a <- (map readInt . words) `fmap` getLine
    print (solveTaskB ((1 `shiftL` (n + 1)) - 1) (0 : a))

solveTaskB length lights =
    fst $ solveForIndex $ 0
        where
            solveForIndex index = if index * 2 + 2 >= length
                then (0, lights !! index)
                else (abs (lDep - rDep) + lAns + rAns, (lights !! index) + (max lDep rDep))
                    where
                        lAns = fst lSon
                        rAns = fst rSon
                        lDep = snd lSon
                        rDep = snd rSon
                        lSon = solveForIndex (2 * index + 1)
                        rSon = solveForIndex (2 * index + 2)

readInt = read :: String -> Int

main = do
 y <- getLine
 if y=="0" then putStrLn "0" else do
    x <- getLine
    putStrLn $ show $ solve (read y)  (map read $ words x)

solve d x = s x (2^d-3)

s x (-2) = 0
s x to = abs(lSon - rSon) +
    s ((take to x)++[(x!!to) + max lSon rSon]++(drop (to+1) x)) (to-1)
    where
    lSon = x!!(2*to+2)
    rSon = x!!(2*to+3)

import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let lights = readLights firstLine
  let tree = buildTree (2^(n+1) - 2) lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  putStrLn (show x)

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

buildTree :: Int -> [Int] -> Tree
buildTree 0 [] = Leaf
buildTree n (ln:rn:remLights) =
  let
    n' = (n `div` 2) - 1
    (lLights, rLights) = splitAt n' remLights
  in
    Node ln rn (buildTree n' lLights) (buildTree n' rLights)

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
  in
    (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)

import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as Fold
import Data.Int
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord
import qualified Data.IntMap.Strict as IM
import Data.Traversable
import qualified Data.Sequence as Seq
--import Prelude hiding (foldl)
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import Debug.Trace

data Tree = Node Int Int Tree Tree | Leaf
  deriving Show

main = do
  firstWords <- fmap BS.words BS.getLine
  let Just (n, _) = BS.readInt $ firstWords !! 0
  lines <- fmap BS.lines BS.getContents
  let firstLine = head lines
  let lights = readLights firstLine
  let (tree, _) = buildTree n lights
  let maxLight = maxLights tree
  let x = lightsNeeded maxLight tree
  putStrLn (show x)

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

buildTree :: Int -> [Int] -> (Tree, [Int])
buildTree 0 xs = (Leaf, xs)
buildTree n (ln:rn:remLights) =
  let
    (lTree, remLights') = buildTree (n-1) remLights
    (rTree, remLights'') = buildTree (n-1) remLights'
  in
    (Node ln rn lTree rTree, remLights'')

maxLights :: Tree -> Int
maxLights Leaf = 0
maxLights (Node ln rn lTree rTree) =
  max (ln + maxLights lTree) (rn + maxLights rTree)

lightsNeeded :: Int -> Tree -> Int
lightsNeeded 0 Leaf = 0
lightsNeeded goal (Node ln rn lTree rTree) =
  let
    ln' = goal - (maxLights lTree)
    rn' = goal - (maxLights rTree)
  in
    (ln' - ln) + (lightsNeeded (goal - ln') lTree) +
      (rn' - rn) + (lightsNeeded (goal - rn') rTree)

main = do
 y <- getLine
 if y=="0" then putStrLn "0" else do
    x <- getLine
    putStrLn $ show $ solve (read y)  (map read $ words x)

solve 0 x = 0
solve d x = (delt rest) + solve (d-1) (zipWith (+) (take ((2^d)-2) x) (comb rest))
 where rest = drop ((2^d)-2) x

delt (x:y:[]) = abs (x-y)
delt (x:y:xs) = (abs (x-y)) + (delt xs)
delt (x:[])   = 0

comb (x:y:[]) = [max x y]
comb (x:y:xs) = (max x y):(comb xs)

import Data.Bits(shiftL)
import Control.Monad

main = do
    n <- readInt `fmap` getLine
    a <- (map readInt . words) `fmap` getLine
    print (solveTaskB ((1 `shiftL` (n + 1)) - 2) a)

solveTaskB length lights =
    fst $ solveForIndex $ 0
        where
            solveForIndex index = if index * 2 + 2 >= length
                then (0, lights !! index)
                else (abs (lDep - rDep) + lAns + rAns, (lights !! index) + (max lDep rDep))
                    where
                        lAns = fst lSon
                        rAns = fst rSon
                        lDep = snd lSon
                        rDep = snd rSon
                        lSon = solveForIndex (2 * index + 1)
                        rSon = solveForIndex (2 * index + 2)

readInt = read :: String -> Int


import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

specMap k [] = []
specMap k [x] = if x == 0 then [0] else [1 + ((x - 1) `div` (k + 1))]
specMap k (x:t) = (x `div` (k + 1)) : specMap k t

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    sum $ specMap k d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp

import Control.Monad
import Data.List

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  [n,k] <- (map read.words) <$> getLine
  s <- getLine
  print $ solve n k s

solve :: Int -> Int -> String -> Int
solve n k s
  | length grpd == 1 && (fst.head) grpd == '1' = 0
  | length grpd == 1 = 1 + ((n-1) `div` (k+1))
  | otherwise = f2 n k grpd
  where
    grpd =map (\l -> (head l, length l)) $ group s

f2 :: Int -> Int -> [(Char,Int)] -> Int
f2 n k (x:xs)
  | fst x == '0' = (snd x `div` (k+1)) + f2 n k xs
  | fst l == '0' = (snd l `div` (k+1)) + f2 n k (init (x:xs))
  | otherwise = r
  where
    l = last (x:xs)
    zs = map snd $ filter ((=='0').fst) (x:xs)
    r = sum $ map (\y -> max 0 $ (y-k) `quot` (k+1)) zs

import Data.List

main :: IO ()
main = do
  inputjar <- getLine
  let n = read inputjar :: Int
  solve n

solve :: Int -> IO ()
solve 0 = putStr ""
solve n = do
  numbers <- getLine
  input <- getLine
  let list = read ("[" ++ map (\x -> if x == ' ' then ',' else x) numbers ++ "]") :: [Int]
  solveCase (list !! 1) input
  solve (n - 1)

solveCase :: Int -> [Char] -> IO()
solveCase x s =  print $ if length (group s) == 1 && head s == '0' then 1 + checkBounds(init s) else foldl check 0 (zip [0..] (init $ group s)) + checkBounds (last $ group s)
    where
        checkBounds group = if length group == 0 then 0 else if (head group == '0') then length group `div` (x + 1) else 0
        check acc group = acc + if fst group == 0 then checkBounds (snd group) else checkInside (snd group)
        checkInside group = if (head group == '0' && length group >= x * 2 + 1) then (length group - x) `div` (x + 1) else 0

-- solveCase :: [Int] -> IO ()
-- solveCase xs = print $ if odd == even then odd else (-1)
--   where
--     odd = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 1 then 0 else 1) 0 [1, 3 .. length xs - 1]
--     even = foldl (\acc i -> acc + if (xs !! i) `mod` 2 == 0 then 0 else 1) 0 [0, 2 .. length xs - 1]

{-# LANGUAGE DeriveFunctor #-}

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

solve n x
  = if all (=='0') x
  then (1+) . solve n $ '1' : tail x
  else sum . map f . map (fmap length) . filter ((=='0') . head . contains) . g False . group $ x
  where
    g :: Bool -> [a] -> [Chairs a]
    g _ [] = error "???"
    g _ [x]        = [Edge x]
    g False (x:xs) = Edge x : g True xs
    g True  (x:xs) = Inside x : g True xs
    f (Edge k) = k `div` (n+1)
    f (Inside k) = f (Edge $ k - n)

data Chairs a = Edge a | Inside a deriving Functor
contains :: Chairs a -> a
contains (Edge a) = a
contains (Inside a) = a

main = readLn >>= flip replicateM_ go where
    go = do
        [_,n] <- getList
        getLine >>= print . solve n

    getList = map read . words <$> getLine

f :: Char -> Int
f = fromIntegral . fromEnum

import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

specMap k [] = []
specMap k [x] = if x == 0 then [0] else [max 1 (x `div` (k + 1))]
specMap k (x:t) = (x `div` (k + 1)) : specMap k t

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    sum $ specMap k d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp

import Control.Monad

dists :: Int -> String -> Int -> Int -> [Int]
dists k [] acc _ = [acc]
dists k (h : t) acc 0
  | h == '0'  = dists k t (acc + 1) 0
  | otherwise = acc : dists k t 0 k
dists k (_ : t) _ b = dists k t 0 (b - 1)

solve (k, seats) =
  let
    d = dists k seats 0 0
  in
    case d of
      [x] -> max 1 (x `div` (k + 1))
      _ -> sum $ map (\x -> x `div` (k + 1)) d

getCase = do
  inp <- getLine
  inp2 <- getLine
  let [n, k] = (map read) $ words inp
  return (k, inp2)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ (putStrLn . show . solve) inp


import Control.Monad

type Test = (Integer, Integer)

getTests :: Integer -> IO [Test]
getTests count = replicateM (fromIntegral count) getTest

getTest :: IO Test
getTest = do
    line <- getLine
    let list = words line
    return (read (head list), read (head $ tail list))

getAnswer :: Test -> Integer
getAnswer (n, k) = remainderGroups + k
    where remainderGroups = (k - 1) `div` (n - 1)

printResult :: Integer -> IO ()
printResult result = print result

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    let results = map getAnswer tests
    mapM_ printResult results

main :: IO ()
main = do
    getLine
    ans <- map (solve . map read . words) <$> lines <$> getContents
    mapM_ print ans

solve :: [Int] -> Int
solve [x,y] = y + f 0 x y

f x y z = let a = (z `div` y) - (x `div` y)
           in case a of
                0 -> 0
                _ -> a + f z y (z + a)

import           Control.Arrow

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

solve :: [Integer] -> Integer
solve [n,k] = ((k-1) `div` (n-1)) * n + ((k-1) `mod` (n-1)) + 1

import Control.Monad (replicateM_)

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

main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getList >>= \[x,y] -> print $ solve x y

solve :: Int -> Int -> Int
solve n k = k + (k-1) `div` (n-1)

solve :: Integer -> Integer -> Integer
solve n k
    | r==0      = n*m-1
    | otherwise = n*m+r
    where
        m = k`div`(n-1)
        r = k`mod`(n-1)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readNums
    print $ solve n k
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readNums
    testCases t

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine


import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

type SIO = StateT P.ByteString IO

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [px, py] <- readInts
    s <- readLine
    let
      [px', py'] = map fromIntegral [px, py]
      minX = 0 - P.count 'L' s
      maxX =     P.count 'R' s
      minY = 0 - P.count 'D' s
      maxY =     P.count 'U' s
    lift . P.putStrLn . P.pack
      $ if  minX <= px' && px' <= maxX && minY <= py' && py' <= maxY
      then "YES"
      else "NO"

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

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

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

solve :: Int -> Int -> String -> Bool
solve px py s = count 'U' s >= py &&
                count 'D' s >= -py &&
                count 'R' s >= px &&
                count 'L' s >= -px
    where count x = length . filter (==x)

main :: IO ()
main = interact (unlines . map (fmtB . uncurry3 solve . getInput) . chunksOf 2 . tail . lines)
    where getInput [a, b] = let [px, py] = toArr a in (px, py, b)
          uncurry3 f (a,b,c) = f a b c

solve :: Int -> Int -> String -> Bool
solve px py s = count 'U' s >= py &&
                count 'D' s >= -py &&
                count 'R' s >= px &&
                count 'L' s >= -px
    where count x = length . filter (==x)

main :: IO ()
main = interact (unlines . map (fmtB . uncurry3 solve . getInput) . chunksOf2 . tail . lines)
    where getInput [a, b] = let [px, py] = toArr a in (px, py, b)
          chunksOf2 [] = []
          chunksOf2 (a : b : l) = [a,b] : chunksOf2 l
          uncurry3 f (a,b,c) = f a b c
          toArr = map (read :: String -> Int) . words
          fmtB True = "YES"
          fmtB False = "NO"

import Control.Monad

solve :: ((Int,Int), String) -> String
solve ((x,y), as)
    | and [x_axis, y_axis]  = "YES"
    | otherwise             = "NO"
    where
        x_axis = or [and [x<0, (abs x) <= ls], and [x>=0, x <= rs]]
        y_axis = or [and [y<0, (abs y) <= ds], and [y>=0, y <= us]]
        ls = (length . filter (=='L')) as
        us = (length . filter (=='U')) as
        ds = (length . filter (=='D')) as
        rs = (length . filter (=='R')) as

-- (x,y)
-- u -> y+1, d -> y-1, r -> x+1, l -> x-1

readTestcase :: IO ((Int, Int), String)
readTestcase = do
    line <- getLine
    let [x,y] = [read i :: Int | i <- words line]
    word <- getLine
    return $ ((x,y),word)

main = do
    t <- getLine
    let t_int = read t :: Int
    testcases <- replicateM t_int readTestcase
    putStrLn $ unlines $ map solve testcases

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

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

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

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

solve :: (Int, Int) -> String -> Bool
solve (px, py) steps = xCan && yCan
    where
        directionCounts :: M.Map Char Int
        directionCounts = foldl (\counts direction -> M.insertWith (+) direction 1 counts) M.empty steps

        xDirection = if px < 0 then 'L' else 'R'
        yDirection = if py < 0 then 'D' else 'U'

        xCan = M.findWithDefault 0 xDirection directionCounts >= abs px
        yCan = M.findWithDefault 0 yDirection directionCounts >= abs py

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [px, py] <- B8.getLine <&> map readIntB8 . B8.words
        steps <- B8.getLine <&> B8.unpack . head . B8.words
        let answer = solve (px, py) steps
        printf "%s\n" $ if answer then "YES" else "NO" :: String


main = interact $ show . solve . map read . words
solve (n:k:a:as) = go a as 0 where
  go a _ i | i >= min (n-1) k = a
  go a (b:as) i | a > b = go a (as ++ [b]) (i+1)
                | otherwise = go b (as ++ [a]) 1

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = (\r -> case r of { [] -> m; (x:_):_ -> x }) $ filter ((>= k) . genericLength) $ group $ tail $ scanl (\w f -> max w f) (head xs) (tail xs)
  where m = maximum xs

module Main (main) where

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

main :: IO ()
main = do
    [n, k] <- map readInt . words <$> getLine
    xs <-  map readInt . words <$> getLine
    let ans = solve n k xs
    print ans

readInt :: String -> Integer
readInt = read

solve n k (x:xs) | k > n     = n
                 | otherwise = fst $ foldl (play k) (x, 0) $ xs ++ xs ++ xs

play k (w, c) p | w == p || c == k = (w, c)
                | w > p            = (w, c+1)
                | w < p            = (p, 1)

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = maybe m fst $ find snd $ zipWith3 (\x ts _ -> (x, all (x>) $ genericTake k ts)) xs (tail $ tails xs) [1..n - k]
  where m = maximum xs

import Data.Int
import Data.List
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:k:xs)
  | k >= n = m :: Int64
  | otherwise = (\r -> case r of { [] -> m; (x:_):_ -> x }) $ filter ((>= k) . genericLength) $ group $ scanl (\w f -> max w f) (head xs) (tail xs)
  where m = maximum xs

module Main (main) where

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

main :: IO ()
main = do
    [n, k] <- map readInt . words <$> getLine
    xs <-  map readInt . words <$> getLine
    let ans = solve n k xs
    print ans

readInt :: String -> Int
readInt = read

solve :: Int -> Int -> [Int] -> Int
solve n k (x:xs) | k > n     = n
                 | otherwise = fst $ foldl (play k) (x, 0) $ xs ++ xs ++ xs

play :: Int -> (Int, Int) -> Int -> (Int, Int)
play k (w, c) p | w == p || c == k = (w, c)
                | w > p            = (w, c+1)
                | w < p            = (p, 1)


module Main where

import Control.Monad

getYearname n m nstr mstr year = (nstr !! yn) ++ (mstr !! ym)
  where
    yn = (year - 1) `mod` n
    ym = (year - 1) `mod` m

main =
  (map (read :: String -> Int) . words) <$> getLine >>= \[n, m] ->
  words <$> getLine >>= \nstr ->
  words <$> getLine >>= \mstr ->
  (read :: String -> Int) <$> getLine >>= \q ->
  replicateM q ((read :: String -> Int) <$> getLine) >>= \years ->
  let
    yearnames = map (getYearname n m nstr mstr) years
  in mapM_ putStrLn yearnames

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! ((i - 1) `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (putStrLn . getYearName) qs

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

repeatNTimes 0 _ = return ()
repeatNTimes n action =
 do
  action
  repeatNTimes (n-1) action

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

main = do
    input1 <- getLine
    let n = read (wordsWhen(==' ') input1 !! 0) :: Int
    let m = read (wordsWhen(==' ') input1 !! 1) :: Int
    input2 <- getLine
    let s = wordsWhen(==' ') input2
    input3 <- getLine
    let t = wordsWhen(==' ') input3
    input4 <- getLine
    let q = read input4 :: Integer
    repeatNTimes q (do
        input5 <- getLine
        let y = read input5 :: Int
        putStrLn (concat [(s !! index y n), (t !! index y m)])
        )

readInt :: IO Int
readInt = do
  line <- getLine
  return $ (map read $ words line) !! 0

readIntList :: IO [Int]
readIntList = do
  line <- getLine
  return $ map read $ words line

readStrList :: IO [String]
readStrList = do
  line <- getLine
  return $ words line

repReadInt :: Int -> IO [Int]
repReadInt 0 = return []
repReadInt q = do
  x <- readInt
  xs <- repReadInt (q - 1)
  return (x:xs)

printStrList :: [String] -> IO()
printStrList [] = return ()
printStrList (x:xs) = do
  putStrLn x
  printStrList xs

main = do
  [n, m] <- readIntList
  s <- readStrList
  t <- readStrList
  [q] <- readIntList
  query <- repReadInt q
  printStrList $ map (\x -> (s !! (mod x n)) ++ (t !! (mod x m)))
                $ map (\x -> x - 1) query

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

process a b c d = do
			e<- read <$> getLine ::IO Int
			replicateM_ e process1
	where process1 = do
				f<-read <$> getLine ::IO Int
				putStr $ c!!(mod (f-1) a)
				putStrLn $ d!!(mod (f-1) b)

main= do
		[a,b]<- map read <$>words <$>  getLine ::IO [Int]
		c<- words <$> getLine
		d<- words <$> getLine
		process a b c d

--ghc 7.10

yearName :: Int -> Int -> [String] -> [String] -> Int -> String
yearName n m ss ts year = ss !! (year' `mod` n) ++ ts !! (year' `mod` m)
    where year' = year-1

yearNames :: Int -> Int -> [String] -> [String] -> [Int] -> [String]
yearNames n m ss ts = map (yearName n m ss ts)

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    ssStr <- getLine
    let ss = words ssStr
    tsStr <- getLine
    let ts = words tsStr
    qStr <- getLine
    contents <- getContents
    let years = map read . words $ contents
    sequence . map putStrLn . yearNames n m ss ts $ years

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

repeatNTimes 0 _ = return ()
repeatNTimes n action =
 do
  action
  repeatNTimes (n-1) action

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

main = do
    input1 <- getLine
    let n = read (wordsWhen(==' ') input1 !! 0) :: Int
    let m = read (wordsWhen(==' ') input1 !! 1) :: Int
    input2 <- getLine
    let s = wordsWhen(==' ') input2
    input3 <- getLine
    let t = wordsWhen(==' ') input3
    input4 <- getLine
    let q = read input4 :: Integer
    repeatNTimes q (do
        input5 <- getLine
        let y = read input5 :: Int
        print (concat [(s !! index y n), (t !! index y m)])
        )

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! (i `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (print . getYearName) qs

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! ((i - 1) `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (print . getYearName) qs


import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	_ <- getLine
	aRR <- getLine
	let
		arr = reverse. map (\x -> read x :: Int). words $ aRR
		len = length arr
		solve :: Int -> [Int] -> Int
		solve _ [] = 0
		solve mn (x:xs)
		 | x > mn = length xs + 1
		 | otherwise = solve (min mn x) xs
	print $ solve (head arr) arr

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

solve :: Int -> [Int] -> Int
solve _ [] = 0
solve mn (x:xs)
 | x > mn = length xs + 1
 | otherwise = solve (min mn x) xs

main :: IO ()
main = getContents >>= print. (\arr -> solve (head arr) arr). reverse. map read. tail. words

main :: IO ()
main = do
    coStr <- getLine
    let n = read coStr
    coStr2 <- getLine
    let a = map read $ words coStr2
    putStrLn $ show $ n - (old a 0)

--solve
old :: [Int] -> Int -> Int
old [] p = p
old [x] p = p+1
old (x:y:ys) p = if x < y then old (y:ys) (p+1) else old (y:ys) 0

old1 [] p = p
old1 [a] p = a:p
old1 (x:y:ys) p = if x < y then old1 (y:ys) (x:p) else old1 (y:ys) []

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

main = do
	n <- readLn
	as <- reverse . map read . words <$> getLine
	print $ n - solve as n

solve [] _ = 0
solve (a:as) prev
	| prev < a = 0
	| otherwise = 1 + solve as a

-- Longest Decreasing Prefix
ldp :: [Int] -> Int
ldp (a:(b:c))
    | a > b     = 1 + ldp (b:c)
    | otherwise = 1
ldp x = length x

main :: IO()
main = do
    str1 <- getLine
    str2 <- getLine
    let n = read str1 :: Int
    let a = map read (words str2) :: [Int]
    (putStrLn . show) (n - ldp (reverse a))

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- (B.getLine >>= return .map readInt . B.words)
    print $ solve n l

solve :: Int ->[Int] -> Int
solve n = (n-) . length . L.takeWhile judge . L.drop 1 . L.scanl update (0,S.empty) . L.reverse
    where
        update (0,_) x = (x,S.empty)
        update (y,s) x = (x,S.insert y s)
        judge (x,s) |S.null s  = True
                    |otherwise = x < S.findMin s

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

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

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

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

main = do
    getLine
    a <- map read `fmap` words `fmap` getLine :: IO [Int]
    let a' = reverse a
    print $ length a - 1 - (length $ takeWhile (uncurry (>)) $ a' `zip` tail a')

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

main = do
	getLine
	as <- map read . words <$> getLine
	print $ solve as

solve :: [Int] -> Int
solve (1:as) = 0
solve (a:as) = 1 + solve as

mins :: Ord a => [a] -> [a]
mins [x] = [x]
mins (x:xs) = let (y:ys) = mins xs in (min x y):y:ys

main = do
    getLine
    a <- map read `fmap` words `fmap` getLine :: IO [Int]
    print $ sum $ map (\(a, b) -> if a > b then 1 else 0) $
        zip a $ mins a

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

solve :: Int -> [Int] -> Int
solve _ [] = 0
solve mn (x:xs)
 | x > mn = length xs + 1
 | otherwise = solve (min mn x) xs

main :: IO ()
main = getContents >>= print. (\arr -> solve (head arr) arr). map read. tail. words

main :: IO ()
main = do
    coStr <- getLine
    let n = read coStr
    coStr2 <- getLine
    let a = map read $ words coStr2
    putStrLn $ show $ n - (old a)

--solve
old :: [Int] -> Int
old [] = 0
old [x] = 1
old (x:y:xs) = if x < y then 1 + (old (y:xs)) else old (y:xs)


import Data.Char

minMoves :: [Int] -> [Int] -> Int
minMoves xs ys = sum $ zipWith unitMinMoves xs ys
  where
  unitMinMoves x y = if i < j then i else j
    where
    i = abs $ x - y
    j = 10 - i

main :: IO ()
main = do
  n <- fmap (read :: String -> Int) getLine
  origin <- fmap (map digitToInt) getLine
  answer <- fmap (map digitToInt) getLine
  print $ minMoves origin answer

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
main= readsolveprint
readsolveprint::IO()
readsolveprint =  solve.tail =<< forM [1..3] (\i -> getLine)
solve [xs,ys] = print $ sum $ zipWith (\ a b -> let c = abs $ digitToInt a - digitToInt b in minimum [c,10-c]) xs ys

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

moves :: Char -> Char -> Int
moves a b = min d (10 - d)
    where d = abs $ digitToInt a - digitToInt b

solve :: String -> String -> Int
solve s t = sum $ zipWith moves s t

main :: IO ()
main = do
    _ <- getLine
    s <- getLine
    t <- getLine
    print $ solve s t

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

process q1 q2 = sum $ zipWith (\z1 z2 -> min (abs (z1 - z2)) (10-(abs (z1-z2))) ) sq1 sq2
   where sq1 =map digitToInt q1
         sq2 = map digitToInt q2

main=do
    n<-     read  <$> getLine::IO Integer
    [q1,q2]<-     lines <$> getContents
    print $ process q1 q2

import Control.Applicative

toNumbers = map toInt

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

distance (a, b) =
  if a <= b
  then min (9+a-b+1) (b-a)
  else distance (b, a)

totalmoves xs ys = sum $ map distance (zip xs ys)

main = do
  n <- getLine
  a <- toNumbers <$> getLine
  b <- toNumbers <$> getLine
  let result = totalmoves a b
  print result

import Data.Char

main = do
  getLine
  s <- getLine
  t <- getLine

  let
    f a b = min (abs (a'-b')) (10 - abs (a' - b'))
      where
        a' = ord a
        b' = ord b

  print $ sum $ zipWith f s t

import Control.Applicative ((<$>), (<*>))
import Data.Char (digitToInt)

main :: IO ()
main = getLine >> solve <$> (map digitToInt <$> getLine) <*> (map digitToInt <$> getLine) >>= print

solve :: [Int] -> [Int] -> Int
solve xs ys = sum $ zipWith (\x y -> 5 - abs (abs (x - y) - 5)) xs ys

import Control.Monad
main = do
  getLine
  print.sum =<< liftM2 (zipWith diff) getLine getLine
diff a b = abs ( (fromEnum a - fromEnum b + 5) `mod` 10 - 5 )

import Control.Monad
import System.IO

online = True
file = "in.txt"

main = do
    handle <- if online then return stdin else openFile file ReadMode
    let gl = hGetLine handle
    gl
    a <- gl
    b <- gl
    putStrLn $ show $ solve a b

solve :: [Char] -> [Char] -> Int
solve a b = sum $ zipWith delta a b

delta :: Char -> Char -> Int
delta x y
    | a > b = d b a
    | otherwise = d a b
    where
    a = read [x]
    b = read [y]

d a b = min (b-a) (a+10-b)

getLines :: IO String -> Int -> IO [String]
getIntList :: IO String -> IO [Int]
getList :: IO String -> IO [String]
toIntTuple :: String -> (Int, Int)

getIntList gl = gl >>= return.(map read).words
getList gl = gl >>= return.words
getLines gl n = replicateM n gl
toTuple x = (words x !! 0, words x !! 1)
toIntTuple x = (read $ words x !! 0, read $ words x !! 1)

import Data.Char

minMoves :: [Int] -> [Int] -> Int
minMoves xs ys = sum $ zipWith unitMinMoves xs ys
  where
  unitMinMoves x y = if i < j then i else j
    where
    i = abs $ x - y
    j = 10 - i

main :: IO ()
main = do
  _ <- fmap (read :: String -> Int) getLine
  origin <- fmap (map digitToInt) getLine
  answer <- fmap (map digitToInt) getLine
  print $ minMoves origin answer

import Data.Char

main :: IO ()

main = do
    _ <- getLine
    s1 <- getLine
    s2 <- getLine
    putStrLn $ show $ sum $ zipWith (\x y ->
        let
            c1 = ord(x) - ord('0')
            c2 = ord(y) - ord('0')
            m1 = min c1 c2
            m2 = max c1 c2
        in min (m2 - m1) (m1 + 10 - m2)) s1 s2

module Main where

alphNumber :: Char -> Int
alphNumber x = (fromEnum x - fromEnum '0')

main = do
    n <- getLine
    strF <- getLine
    strS <- getLine
    print $ sum
          $ map (\(x, y) -> min
                (mod ((alphNumber y) - (alphNumber x)) 10)
                (mod ((alphNumber x) - (alphNumber y)) 10) )
          $ zip strF strS
    return ()

import Control.Applicative
import Data.Char

process (x,y) = min (mod (xx-yy) 10) (mod (yy-xx) 10)
	where 	xx = ord x
		yy = ord y

main= do
	getLine
	[a,b]<-sequence [getLine,getLine]
	print $ sum $ map process $ zip a b

import Data.Char

distance :: [Int] -> [Int] -> Int
distance xs ys = sum $ zipWith d xs ys

d :: Int -> Int -> Int
d a b = min ((b - a) `mod` 10) ((a - b) `mod` 10)

solve :: String -> String
solve s = show $ distance xs ys
    where _:xs:ys:_ = fmap (fmap digitToInt) . lines $ s

main :: IO ()
main = interact $ solve

import Data.Char

solve :: String -> String -> Int
solve [] [] = 0
solve (x:xs) (y:ys) = m + solve xs ys where
    a = min (digitToInt x) (digitToInt y)
    b = max (digitToInt x) (digitToInt y)
    m = min (b - a) (10 + a - b)

main :: IO ()
main = do
    input <- getContents
    let [xs, ys] = tail $ lines input
    print $ solve xs ys

module Main (main)
    where

import Data.Char (digitToInt)
import Control.Monad (replicateM)

readInts :: String -> [Int]
readInts = map digitToInt

main :: IO ()
main = print . solve . map readInts =<< (getLine >> replicateM 2 getLine)
    where solve [xs,ys] = sum $ zipWith moves xs ys
          moves a b = min (abs $ a - b) (9 - max a b + min a b + 1)

f_ a b =
    let c1 = min a b ; c2 = max a b in min (abs (c1-c2)) (abs (c1 + (10-c2)))

f str str2 = sum $ zipWith (f_) (map (read . (:[])) str) (map (read . (:[])) str2)

main = do {
    getLine ;
    str1 <- getLine ;
    str2 <- getLine ;
    putStrLn (show $ f str1 str2)
}

import Data.Char
import Data.Foldable as F
import Data.Monoid as M

readInt :: IO Int
readInt = do
    i <- getLine
    return $ read i

readIntString :: IO [Int]
readIntString = do
    s <- getLine
    return $ map (digitToInt) s

minMoves :: [Int] -> [Int] -> Int
minMoves s1 s2 = M.getSum $ F.foldMap (\(mn, mx) -> M.Sum $ min (mx - mn) (mn - mx + 10)) (map minMax (zip s1 s2) )
    where minMax = \(x,y) -> (min x y, max x y)

main :: IO ()
main = do
    n <- readInt
    s1 <- readIntString
    s2 <- readIntString
    putStrLn $ show $ minMoves s1 s2

conv ppp lst
  | (null ppp) = lst
  | otherwise = conv (tail ppp) (lst ++ [((read [head ppp])::Int)])

lock aa bb sum
  | (null aa) = sum
  | otherwise = lock (tail aa) (tail bb) (sum + (minimum [(abs (one-two)), ((10-one) + two),
                                                         (one + (10-two))]))
                where one = (head aa)
                      two = (head bb)

main = do
  ff <- getLine
  gg <- getLine
  hh <- getLine

  let ans = lock (conv gg []) (conv hh []) 0

  -- let cc = conv gg []
  -- putStrLn (show cc)

  putStrLn (show ans)

import Data.Char (digitToInt)
main = do
  w <- getLine
  w0 <- getLine
  let a = [digitToInt n|n <- w0]
  w1 <- getLine
  let b = [digitToInt n|n <- w1]
  print $ sum $ map f (zip a b)
      where f x = min t (10-t) where t = abs((snd x) - (fst x))

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

process q1 q2 = sum $ zipWith (\z1 z2 -> min (abs (z1 - z2)) (abs (10-z1+z2))) sq1 sq2
   where sq1 =map digitToInt q1
         sq2 = map digitToInt q2

main=do
    n<-     read  <$> getLine::IO Integer
    [q1,q2]<-     lines <$> getContents
    print $ process q1 q2