import Char (isSpace)
import Control.Monad (liftM)
import Data.Array.MArray (readArray, writeArray)
import Data.Array.IO (IOUArray, newArray_, newListArray)

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

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

getInt :: IO Int
getInt  =  do
    c  <-  getChar
    isSpace c ? getInt $ getInt' (fromEnum c - fromEnum '0')
  where
    getInt' a  =  do
        c  <-  getChar
        isSpace c ? return a $ getInt' (10*a + fromEnum c - fromEnum '0')

readArray :: (Int, Int) -> IO (IOUArray (Int, Int) Int)
readArray (n, m)  =  do
    array  <-  newArray_ ((1,1), (n,m))
    readArray' 1 1 array
  where
    readArray' i j array
      | i > n  =  return array
      | j > m  =  readArray' (i+1) 1 array
      | otherwise  =  do
          x <- getInt
          writeArray array (i,j) x
          readArray' i (j+1) array

f :: Int -> IO (IOUArray Int Int)
f n  =  do
    array  <-  newListArray (1,n) [1..]
    return array

solve :: Int -> (Int, Int) -> IOUArray (Int, Int) Int -> IO ()
solve k (n, m) array  =  do
    colArray  <-  f m
    rowArray  <-  f n
    solve' k colArray rowArray array
  where
    solve' 0 _ _ _ =  return ()
    solve' k colArray rowArray array  =  do
        c  <-  getChar
        x  <-  getInt
        y  <-  getInt
        case c of
            'g'  ->  do
                i  <-  Data.Array.MArray.readArray rowArray x
                j  <-  Data.Array.MArray.readArray colArray y
                a  <-  Data.Array.MArray.readArray array (i, j)
                print a
            'c'  ->  swap x y colArray
            'r'  ->  swap x y rowArray
        solve' (k-1) colArray rowArray array
    swap x1 x2 array  =  do
        a1  <-  Data.Array.MArray.readArray array x1
        a2  <-  Data.Array.MArray.readArray array x2
        Data.Array.MArray.writeArray array x1 a2
        Data.Array.MArray.writeArray array x2 a1

main :: IO ()
main  =  do
    [n, m, k]  <-  liftM (map read . words) getLine
    arr  <-  Main.readArray (n, m)
    solve k (n,m) arr

{-# LANGUAGE BangPatterns #-}

import Data.Array.Base
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Monad

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,m,k] <- map read.words <$> getLine
  table <- map readInt.B.words.B.concat <$> replicateM n B.getLine
  arr <- newListArray (0,n*m-1) table :: IO (IOUArray Int Int)
  toRow <- newListArray (0,n-1) [0..] :: IO (IOUArray Int Int)
  toCol <- newListArray (0,m-1) [0..] :: IO (IOUArray Int Int)
  let swapCol x y = do
        ax <- unsafeRead toCol x
        ay <- unsafeRead toCol y
        unsafeWrite toCol x ay
        unsafeWrite toCol y ax
      swapRow x y = do
        ax <- unsafeRead toRow x
        ay <- unsafeRead toRow y
        unsafeWrite toRow x ay
        unsafeWrite toRow y ax
      query s !x !y= do
        case B.head s of
          'c' -> swapCol x y
          'r' -> swapRow x y
          'g' -> do
            xx <- unsafeRead toRow x
            yy <- unsafeRead toCol y
            unsafeRead arr (xx*m+yy) >>= print
  queries <- B.words <$> B.getContents
  let solve [] = return ()
      solve (s:x:y:rest) = do
        query s (readInt x-1) (readInt y-1)
        solve rest
  solve queries


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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

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

main = do
  s <- getLine

  let
    [l, r] = splitOn "^" s

    ll = sum $ map fromIntegral $ zipWith (\c i -> if c == '=' then 0 else (ord c - 48) * i) (reverse l) [1..] :: Int64
    rr = sum $ map fromIntegral $ zipWith (\c i -> if c == '=' then 0 else (ord c - 48) * i) r [1..]

  putStrLn $
    case compare ll rr of
      LT -> "right"
      EQ -> "balance"
      GT -> "left"

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

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

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

main = do
    s <- getLine
    let Just p = findIndex (=='^') s
    let moment :: Integer
        moment = sum $ do
        (ch,i) <- zip s [0..]
        guard (ch /= '=' && ch /= '^')
        let d = digitToInt ch
        return $ fromIntegral $ d * (i-p)
    putStrLn $ if moment == 0 then
        "balance"
    else if moment < 0 then "left" else "right"

module Main where
import Data.Maybe
import Control.Applicative
import Data.Char
import Data.List

main = do
    let (zero, one)= (0::Integer, 1::Integer)
        int = toInteger . digitToInt
        moment = sum . zipWith  (\y x-> if x /= '=' then int x  * y else zero) [one..]
    (a',b') <- (\z -> let x = fromJust $ findIndex (=='^') z in splitAt x z) <$> getLine
    let [a,b] = map moment [reverse a', tail b']
    putStrLn $ case compare a b of
                    LT -> "right"
                    GT -> "left"
                    EQ -> "balance"

module Main where
--import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
import Data.Char
import Data.List

main = do
    let (zero, one)= (0::Integer, 1::Integer)
        int = toInteger . digitToInt
        moment = sum . zipWith  (\y x-> if x /= '=' then int x  * y else zero) [one..]  -- . B.unpack
    (a',b') <- (\z -> let x = fromJust $ findIndex (=='^') z in splitAt x z) <$> getLine
    -- B.breakSubstring  (B.singleton '^') <$> B.getLine -}
    let [a,b] = map moment [reverse a', tail b']
    putStrLn $ case compare a b of
                    LT -> "right"
                    GT -> "left"
                    EQ -> "balance"

#!/usr/bin/env runghc
import Data.Char
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c:cs) = (:solve cs)$ if lw==rw then "balance" else if lw>rw then "left" else "right"
  where
    [l,r] = words . map cnv $ c
    [lw,rw] = map (sum . zipWith (*) [1..] . map (toInteger . (flip (-) (ord '0')) . ord)) [reverse l, r]
cnv '=' = '0'
cnv '^' = ' '
cnv c = c

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

tr '=' = '0'
tr x = x

main= do
	s<-  getLine
	let s1 = map (\z-> fromIntegral (ord z- ord '0')) $ map tr $ reverse $ takeWhile (/='^') s
	let s2 = map (\z-> fromIntegral (ord z- ord '0')) $ map tr $ tail $ dropWhile (/='^') s
	let r1 = (sum $ zipWith (*) s1 [1..])::Integer
	let r2= (sum $ zipWith (*) s2 [1..])::Integer
	putStrLn $ if r1==r2 then "balance" else if r1>r2 then "left" else "right"

import Data.List
import Data.Char

main = interact $ getAns . break (=='^')

getAns :: (String, String) -> String
getAns (ls, p:rs)
	| lw == rw = "balance"
	| lw > rw = "left"
	| otherwise = "right"
	where lw = calW $ reverse ls;
		  rw = calW rs;

getW :: Char -> Int
getW x
	| isNumber(x) = ord x - ord '0'
	| otherwise = 0

calW :: String -> Integer
calW = sum . zipWith (*) [1..] . map (toInteger . getW)

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Control.Arrow
import Data.Int

debug x = trace ("# " ++ show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)
car = head
cdr = tail
cadr = head . tail

--readInt = fst.fromJust.B.readInt
readIntList = return . map read . words :: String -> IO [Int]
toDigit n = chr (48 + n)
chr2num c = ord c - ord '0'

main = do
  ls <- getContents ||> lines
  -- n  <- car ls |> readIO :: IO Int
  -- [n,m]  <- car ls |> words |> map read |> return :: IO Int
  putStrLn $ solve $ car ls

solve l =
  let pos = l |> takeWhile (/= '^') |> length in

  let m = loop l (-pos) 0 in

  if m == 0 then "balance"
    else if m > 0 then "right" else "left"

  where
    loop :: String -> Int -> Int64 -> Int64
    loop [] _ ac = ac
    loop (x:xs) idx m =
      if (c < 1 || c > 9)
        then loop xs (idx+1) m
        else loop xs (idx+1) (m + (fromIntegral $ idx * c :: Int64))
      where
        c = chr2num x

-- vim: set ft=haskell:

import Data.Int (Int64)
import Data.List (foldl')
main = do
	x <- getLine
	putStrLn ( find x )
	where
 	parseChar c = if c == '=' then 0 else read [c] :: Int64
	force xs = foldl' calc  0 (zip [1..] (map parseChar xs ) )
		where
			calc :: Int64 -> (Int64,Int64) -> Int64
			calc acc (len,weight) = (weight * len + acc)
	find s | left  == right = "balance"
           | left  >  right = "left"
           | left  <  right = "right"
		where
			notSep c = c /= '^'
			left  = force ( reverse( takeWhile notSep s ) )
			right = force ( drop 1 ( dropWhile notSep s ) )

import Data.Int (Int64)
import Data.List (foldl')
import Data.Char (digitToInt)
main = do
	x <- getLine
	putStrLn ( find x )
	where
 	parseChar c = if c == '=' then 0 else fromIntegral( digitToInt c )
	force xs = foldl' calc  0 (zip [1..] (map parseChar xs ) )
		where
			calc :: Int64 -> (Int64,Int64) -> Int64
			calc acc (len,weight) = (weight * len + acc)
	find s | left  == right = "balance"
           | left  >  right = "left"
           | left  <  right = "right"
		where
			notSep c = c /= '^'
			left  = force ( reverse( takeWhile notSep s ) )
			right = force ( drop 1 ( dropWhile notSep s ) )

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

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

main = do
  s <- getLine

  let
    [l, r] = splitOn "^" s

    ll = sum $ zipWith (\c i -> if c == '=' then 0 else (ord c - 48) * i) (reverse l) [1..]
    rr = sum $ zipWith (\c i -> if c == '=' then 0 else (ord c - 48) * i) r [1..]

  putStrLn $
    case compare ll rr of
      LT -> "right"
      EQ -> "balance"
      GT -> "left"

main = do
	x <- getLine
	putStrLn ( find x )
	where
	splitOn sep xs = split xs []
		where
		split (x:xs) acc = if x == sep then [acc,xs] else split xs (x:acc)
	parseChar c = if c == '=' then 0 else read [c] :: Int
	force xs = calc 1 (map parseChar xs )
		where
			calc _ [] = 0
			calc i (x:xs) = ( i * x ) + (calc (i+1) xs)
	find s | left  == right = "balance"
           | left  >  right = "left"
           | left  <  right = "right"
		where
			pair = splitOn '^' s
			left = force ( head pair )
			right = force ( last pair )

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

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

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

main = do
    s <- getLine
    let Just p = findIndex (=='^') s
    let moment = sum $ do
        (ch,i) <- zip s [0..]
        guard (ch /= '=' && ch /= '^')
        let d = digitToInt ch
        return $ d * (i-p)
    putStrLn $ if moment == 0 then
        "balance"
    else if moment < 0 then "left" else "right"

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

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

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

main = do
    s <- getLine
    let Just p = findIndex (=='^') s
    let moment = sum $ do
        (ch,i) <- zip s [0..]
        guard (ch /= '=' && ch /= '^')
        let d = digitToInt ch
        return $ d * (i-p)
    putStrLn $ if moment == 0 then
        "barance"
    else if moment < 0 then "left" else "right"

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Data.Char

main = do
    (a',b') <- B.breakSubstring  (B.singleton '^') <$> B.getLine
    let [a,b] = map (sum . zipWith  (\y x->  if x >= '1' && x <= '9'  then  digitToInt x * y else 0) [1..] .  B.unpack)  [B.reverse a', B.tail b']
    putStrLn $ case compare a b of
                    LT -> "right"
                    GT -> "left"
                    EQ -> "balance"

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

tr '=' = '0'
tr x = x

main= do
	s<-  getLine
	let s1 = map (\z-> ord z- ord '0') $ map tr $ reverse $ takeWhile (/='^') s
	let s2 = map (\z-> ord z- ord '0') $ map tr $ tail $ dropWhile (/='^') s
	let r1 = sum $ zipWith (*) s1 [1..]
	let r2= sum $ zipWith (*) s2 [1..]
	putStrLn $ if r1==r2 then "balance" else if r1>r2 then "left" else "right"

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Control.Arrow
import Data.Int

debug x = trace ("# " ++ show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)
car = head
cdr = tail
cadr = head . tail

--readInt = fst.fromJust.B.readInt
readIntList = return . map read . words :: String -> IO [Int]
toDigit n = chr (48 + n)
chr2num c = ord c - ord '0'

main = do
  ls <- getContents ||> lines
  -- n  <- car ls |> readIO :: IO Int
  -- [n,m]  <- car ls |> words |> map read |> return :: IO Int
  putStrLn $ solve $ car ls

solve l =
  let pos = l |> takeWhile (/= '^') |> length in

  let m = loop l (0, pos) 0 in

  if m == 0 then "balance"
    else if m < 0 then "right" else "left"

  where
    loop :: String -> (Int, Int) -> Int64 -> Int64
    loop [] _ ac = ac
    loop (x:xs) (idx, pos) m =
      if (c < 1 || c > 9)
        then loop xs (idx, pos) m
        else loop xs (idx+1, pos) (m + (fromIntegral $ (pos-idx) * c :: Int64))
      where
        c = chr2num x

-- vim: set ft=haskell:

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Control.Arrow

debug x = trace ("# " ++ show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)
car = head
cdr = tail
cadr = head . tail

--readInt = fst.fromJust.B.readInt
readIntList = return . map read . words :: String -> IO [Int]
toDigit n = chr (48 + n)
chr2num c = ord c - ord '0'

main = do
  ls <- getContents ||> lines
  -- n  <- car ls |> readIO :: IO Int
  -- [n,m]  <- car ls |> words |> map read |> return :: IO Int
  putStrLn $ solve $ car ls

solve l =
  let (p, ls) = lead l 0 (0, []) in
  let m = ls |> map (\(x,w) -> (p-x) * w) |> sum in
  if m == 0 then "balance"
    else if m < 0 then "right" else "left"

  where
    lead :: String -> Int -> (Int, [(Int,Int)]) -> (Int, [(Int,Int)])
    lead [] _ ac = ac
    lead ('^':xs) idx (_, ls) = lead xs (idx+1) (idx, ls)
    lead ('=':xs) idx ac = lead xs (idx+1) ac
    lead (x:xs) idx (p, ls) =
      lead xs (idx + 1) (p, (idx, chr2num x) : ls)

-- vim: set ft=haskell:


import Data.Bits
import Data.List

bits :: Integral a => a -> [a]
bits n = bitsWithMul n 1
    where bitsWithMul 0 _ = []
          bitsWithMul n m
            | n `mod` 2 == 1    = m : bitsWithMul (n `div` 2) (m * 2)
            | otherwise         =     bitsWithMul (n `div` 2) (m * 2)

split :: Integral a => [a] -> Int -> [a]
split xs k = splitWithRedun xs (k - length xs)
    where splitWithRedun xs 0 = xs
          splitWithRedun (x:xs) k
            | x /= 1    = let hf = x `div` 2 in splitWithRedun (hf : hf : xs) (k - 1)
            | otherwise = 1 : splitWithRedun xs k

main = do
    s <- getLine
    let [n, k] = map read (words s) :: [Int]
    if k < popCount n || k > n then
        putStrLn "NO"
    else do
        putStrLn "YES"
        putStrLn (intercalate " " (map show (split (bits n) k)))

module Main where

import Control.Applicative

data Pow2 = Pow2 { power :: Int, count :: Int }
          deriving (Show, Eq)

type Decomposition = [Pow2]

toPows :: Pow2 -> [Int]
toPows (Pow2 p c) = replicate c (2 ^ p)

decompose :: Int -> Decomposition
decompose = reverse . go 0
    where go offset n | n == 0 = []
                      | even n = go (offset + 1) (n `div` 2)
                      | otherwise = (Pow2 offset 1) : go (offset + 1) (n `div` 2)

emplace :: Pow2 -> Decomposition -> Decomposition
emplace p [] = [p]
emplace lhs@(Pow2 p1 c1) ps@(rhs@(Pow2 p2 c2):rs) | p1 > p2 = lhs : ps
                                                  | p1 < p2 = rhs : emplace lhs rs
                                                  | otherwise = (Pow2 p1 (c1 + c2)):rs

solve :: Int -> Int -> Maybe Decomposition
solve n k = go ds cr
    where ds = decompose n
          cr = sum $ map count ds

          go :: Decomposition -> Int -> Maybe Decomposition
          go [] _ = Nothing
          go ds@(Pow2 p c : rds) curr | curr > k = Nothing
                                      | curr == k = Just ds
                                      | p == 0 = Nothing
                                      | r < c = go ((Pow2 p (c - r)) `emplace` ((Pow2 (p - 1) (2 * r)) `emplace` rds))
                                                (curr + r)
                                      | otherwise = go (Pow2 (p - 1) (2 * c) `emplace` rds)
                                                    (curr + c)
              where r = k - curr

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  case solve n k of
    Just ds -> do putStrLn "YES"
                  putStrLn . unwords . map show $ concatMap toPows ds
    Nothing -> putStrLn "NO"

module Main where

import Data.Bits (shiftR)

inAdd :: (Int, Int) -> Int
inAdd (i, x) = let b = mod (shiftR x i) 2 in if b == 1 then 2 ^ i else b

getKAdds :: [Int] -> Int -> [Int]
getKAdds adds@(x : xs) k
    | x > 1 && k > 0  = let d = div x 2 in getKAdds (d : d : xs) (k - 1)
    | x == 1 && k > 0 = 1 : getKAdds xs k
    | otherwise       = adds
getKAdds _ _ = []

main :: IO ()
main = do
    nkStr <- getLine
    let [n, k] = map read (words nkStr) :: [Int]
    let adds = filter ((/=) 0) $ map inAdd (zip [0..] (replicate 32 n))
    let kAdds = getKAdds adds (k - length adds)
    if length kAdds /= k
    then putStrLn "NO"
    else do
        putStrLn "YES"
        mapM_ (\x -> putStr $ show x ++ " ") kAdds

import Data.Bits
import Data.List

bits :: Integral a => a -> [a]
bits n = bitsWithMul n 1
    where bitsWithMul 0 _ = []
          bitsWithMul n m
            | n `mod` 2 == 1    = m : bitsWithMul (n `div` 2) (m * 2)
            | otherwise         =     bitsWithMul (n `div` 2) (m * 2)

split :: Integral a => [a] -> Int -> [a]
split xs k = splitWithRedun xs (k - length xs)
    where splitWithRedun xs 0 = xs
          splitWithRedun (x:xs) k
            | x /= 1    = let hf = x `div` 2 in splitWithRedun (hf : hf : xs) (k - 1)
            | otherwise = 1 : splitWithRedun xs k

main = do
    s <- getLine
    let [n, k] = map read (words s) :: [Int]
    if k < popCount n || k >= n then
        putStrLn "NO"
    else do
        putStrLn "YES"
        putStrLn (intercalate " " (map show (split (bits n) k)))

module Main where

import Data.Bits (shiftR)

inAdd :: (Int, Int) -> Int
inAdd (i, x) = let b = mod (shiftR x i) 2 in if b == 1 then 2 ^ i else b

getKAdds :: [Int] -> Int -> [Int]
getKAdds adds@(x : xs) k
    | x > 1 && k > 0  = div x 2  : getKAdds (div x 2 : xs) (k - 1)
    | x == 1 && k > 0 = 1 : getKAdds xs k
    | otherwise       = adds
getKAdds _ _ = []

main :: IO ()
main = do
    nkStr <- getLine
    let [n, k] = map read (words nkStr) :: [Int]
    let adds = filter ((/=) 0) $ map inAdd (zip [0..] (replicate 32 n))
    let kAdds = getKAdds adds (k - length adds)
    if length kAdds /= k
    then putStrLn "NO"
    else do
        putStrLn "YES"
        mapM_ (\x -> putStr $ show x ++ " ") kAdds


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

process n m 	| n==1 = "YES"
		| m==1 = "YES"
		| n==2 && m==2 = "YES"
		| otherwise = "NO"

onecase = do
		[n,m]<-map read <$> words <$> getLine ::IO [Int]
		putStrLn$ process n m
main= do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase

import Control.Monad.State.Lazy

solve :: Int -> Int -> String
solve 1 _ = "YES"
solve _ 1 = "YES"
solve 2 2 = "YES"
solve _ _ = "NO"

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

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

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

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine

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

process n m 	| n==1 && m <4 = "YES"
		| m==1 && n <4 = "YES"
		| n==2 && m==2 = "YES"
		| otherwise = "NO"

onecase = do
		[n,m]<-map read <$> words <$> getLine ::IO [Int]
		putStrLn$ process n m
main= do
		n<- read <$> getLine ::IO Int
		replicateM_ n onecase


module Main where

import List

readNum::String -> (Int,String)
readNum x = case y of
              "-" -> ((-1)*(read z),zs)
              _ -> (read y,xs)
            where
              (y,xs) = head(lex x)
              (z,zs) = head(lex xs)

makeList::Int -> String -> [Int]
makeList 0 _ = []
makeList n x = y:(makeList (n-1) xs)
               where
                 (y,xs) = readNum x

takeIthOrder i n [x] =
    case (i==n) of
      True -> (x,"YES")
      False -> (x,"NO")
takeIthOrder i n (x:y:xs) =
    case (i==n) of
      True -> (x, "YES")
      False ->
          case (x==y) of
            True -> takeIthOrder i n (y:xs)
            False -> takeIthOrder (i+1) n (y:xs)

takeIth n x = takeIthOrder 1 n x

answer (num,str) =
    case str of
      "YES" -> show num
      "NO" -> str

main =
    do
      n <- getLine
      line <- getLine
      putStrLn( answer (takeIth 2 ( sort (makeList (read n) line) ) ) )

{-# LANGUAGE RankNTypes #-}

import Control.Monad
import Data.List
import Data.Array
import System.IO

import Data.List
import Data.Ord
import Data.Array
import Control.Monad

main = do readLn::IO Int
          xs <- (map (read::(String -> Integer)) . words) `liftM` getLine
          let ys = group $ sort xs
          putStrLn $ out ys
  where
    out (a:b:_) = show (head b)
    out _ = "NO"

main = getContents >>= putStrLn . secondmin . quicksort . map read . words . head . tail . lines

secondmin ::  [Int]  -> String
secondmin xs
			| ans == [] = "NO"
			| otherwise = show $ minimum ans
			where ans 	= filter (/= minimum xs) xs

quicksort :: [Int]  -> [Int]
quicksort []           =  []
quicksort (x:xs)       =  quicksort [y | y <- xs, y<x ]
                       ++ [x]
                       ++ quicksort [y | y <- xs, y>=x]

import Data.List
main = getLine >> getLine >>= putStrLn. (\x -> if length x < 2 then "NO" else show $ head (x!!1)) . group . sort . map (read ::String -> Int ) . words

import List (sort)

solve :: [Int] -> Maybe Int
solve xs
  | null xsWithoutMin  =  Nothing
  | otherwise  =  Just $ head xsWithoutMin
  where
    sortXs  =  sort xs
    xsWithoutMin  =  filter (/= head sortXs) sortXs

printAns :: Maybe Int -> IO ()
printAns Nothing  =  putStrLn "NO"
printAns (Just x)  =  print x

main :: IO ()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    printAns $ solve xs

import Data.List

gao :: [Int] -> String
gao xs
    | length a > 1 = show $ a !! 1
    | otherwise = "NO"
    where
        a = sort $ nub xs

main :: IO()
main = do
    _ <- getLine
    line <- getLine
    let a = map read $ words line
    putStrLn $ gao a

import Data.List( sort, nub)

main = do
    getLine
    ints <- return . map read . words =<< getLine
    let sis = nub . sort $ ints
	sis::[Int]
    if length sis == 1
      then putStr "NO"
      else print $ sis!!1

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

main = do
		n<-getLine
		a<- drop 1 <$> group <$> sort <$> map read <$> words <$> getLine::IO [[Int]]
		putStrLn $ if a==[] then "NO" else show $ head $ head a

import Data.List (sort, words, group)

main = do
    n <- getLine
    numbersStr <- getLine
    let numbersInt = (map (\y -> read y :: Int) (words numbersStr))
        sortedNumbers = sort numbersInt

    if (length (group sortedNumbers)) == 1 then
        putStrLn "NO"
    else
        putStrLn $ show (head (head (tail (group sortedNumbers))))
    {-putStrLn $ show (map (\y -> read y :: Int) (words numbers))-}
    {-putStrLn $ show (map (read::Int) (words numbers))-}
    {-putStrLn  (words numbers)-}

main = getContents >>= putStrLn . show . secondmin . quicksort . map read . words . head . tail . lines

secondmin ::  [Int]  -> Int
secondmin xs
			| ans == [] = minimum xs
			| otherwise = minimum ans
			where ans 	= filter (/= minimum xs) xs

quicksort :: [Int]  -> [Int]
quicksort []           =  []
quicksort (x:xs)       =  quicksort [y | y <- xs, y<x ]
                       ++ [x]
                       ++ quicksort [y | y <- xs, y>=x]

import Data.List (sort, words, group)

main = do
    n <- getLine
    numbersStr <- getLine
    let numbersInt = (map (\y -> read y :: Int) (words numbersStr))
        sortedNumbers = sort numbersInt

    if (length (group sortedNumbers)) == 1 then
        putStrLn "No"
    else
        putStrLn $ show (head (head (tail (group sortedNumbers))))
    {-putStrLn $ show (map (\y -> read y :: Int) (words numbers))-}
    {-putStrLn $ show (map (read::Int) (words numbers))-}
    {-putStrLn  (words numbers)-}

import Data.List (sort, words, group)

main = do
    n <- getLine
    numbersStr <- getLine
    let numbersInt = (map (\y -> read y :: Int) (words numbersStr))
        sortedNumbers = sort numbersInt

    if (length (group sortedNumbers)) == 1 then
        putStrLn "No"
    else
        putStrLn $ show (head (tail (group sortedNumbers)))
    {-putStrLn $ show (map (\y -> read y :: Int) (words numbers))-}
    {-putStrLn $ show (map (read::Int) (words numbers))-}
    {-putStrLn  (words numbers)-}


import Data.List
main=interact$f.map read.words
f(n:m:d:x:xs)
  | all (r==) $ map (`rem`d) xs = show.sum $ map(\y->abs(y-p))ys
  | otherwise = "-1"
   where
     r = x `rem` d
     ys = sort.map (\x->(x-r)`quot`d) $ x:xs
     p = ys!!div(n*m)2

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List
import Debug.Trace

main = do
    [n,m,d] <- map read . words <$> getLine
    l <- replicateM n (map read . words <$> getLine)
    print $ solve n m d (join l)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n m d l | check     = search f (-20000) (20000)
              | otherwise = -1
    where
        a       = head l
        check   = and [ (a - b) `mod` d == 0 | b <- l ]
        maxV    = maximum l
        minV    = minimum l
        minP    = minimum [ k | k <- [-20000..20000] , a + k*d >= minV ]
        maxP    = maximum [ k | k <- [-20000..20000] , a + k*d <= maxV ]
        f i     = sum [ abs (a + i*d - b) `div` d | b <- l]

search f l r = loop l r
    where
        loop l r | r - l <= 2 = minimum [f l,f (l+1),f (l+2)]
                 | (f m1 < f m2) = loop l m2
                 | otherwise   = loop m1 r
            where
                m1 = (l*2+r) `div` 3
                m2 = (l+r*2) `div` 3

itof :: Int -> Double
itof = fromIntegral

import Control.Applicative
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B

main = B.interact $ showBI . rd . B.lines
rd (nmd:mat) = go (readBI <$> B.words nmd) (concat $ map readBI <$> B.words <$> mat)
go (_:_:d:[]) mt | (alleq $ (`mod`d) <$> mt) == True = (`div`d) . f . sort $  mt
                 | otherwise                         = -1
f x = g 0 (length x) 0 (sum x) x
      where g ll _ ls _ [] = ls
            g ll rl ls rs (y:ys) = (abs (ll*y-ls) + abs (rl*y-rs))`min`(g (ll+1) (rl-1) (ls+y) (rs-y) ys)
alleq (x:[]) = True
alleq (x:y:xs) = (x==y)&&(alleq (y:xs))

showBI :: Int -> B.ByteString
showBI = B.pack . show

readBI :: B.ByteString -> Int
readBI = fst . fromJust . B.readInt

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List

main = do
    [n,m,d] <- map read . words <$> getLine
    l <- replicateM n (map read . words <$> getLine)
    print $ solve n m d (join l)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n m d l | check     = search f minP maxP
              | otherwise = -1
    where
        a       = head l
        check   = and [ (a - b) `mod` d == 0 | b <- l ]
        maxV    = maximum l
        minV    = minimum l
        minP    = minimum [ k | k <- [-20000..20000] , a + k*d >= minV ]
        maxP    = maximum [ k | k <- [-20000..20000] , a + k*d <= maxV ]
        f i     = sum [ abs (a + i*d - b) `div` d | b <- l]

search f l r = loop l r
    where
        loop l r | l - r <= 2 = minimum [f l,f (l+1),f (l+2)]
                 | f m1 < f m2 = loop l m2
                 | otherwise   = loop m1 r
            where
                m1 = (l*2+r) `div` 3
                m2 = (l+r*2) `div` 3

itof :: Int -> Double
itof = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List

main = do
    [n,m,d] <- map read . words <$> getLine
    l <- replicateM n (map read . words <$> getLine)
    print $ solve n m d (join l)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n m d l | check     = search f minP maxP
              | otherwise = -1
    where
        a       = head l
        check   = and [ (a - b) `mod` d == 0 | b <- l ]
        maxV    = maximum l
        minV    = minimum l
        minP    = minimum [ k | k <- [-10000..10000] , a + k*d >= minV ]
        maxP    = maximum [ k | k <- [-10000..10000] , a + k*d <= maxV ]
        f i     = sum [ abs (a + i*d - b) `div` d | b <- l]

search f l r = loop l r
    where
        loop l r | l - r <= 2 = minimum [f l,f (l+1),f (l+2)]
                 | f m1 < f m2 = loop l m2
                 | otherwise   = loop m1 r
            where
                m1 = (l*2+r) `div` 3
                m2 = (l+r*2) `div` 3

itof :: Int -> Double
itof = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List

main = do
    [n,m,d] <- map read . words <$> getLine
    l <- replicateM n (map read . words <$> getLine)
    print $ solve n m d (join l)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n m d l | check     = search f minP maxP
              | otherwise = -1
    where
        a       = head l
        check   = and [ (a - b) `mod` d == 0 | b <- l ]
        maxV    = maximum l
        minV    = minimum l
        minP    = minimum [ k | k <- [-10000..10000] , a + k*d >= minV ]
        maxP    = maximum [ k | k <- [-10000..10000] , a + k*d <= maxV ]
        f i     = sum [ abs (a + i*d - b) `div` d | b <- l]

search f l r = loop l r
    where
        loop l r | l - r <= 2 = minimum [f l,f (l+1),f (l+2)]
                 | f m1 > f m2 = loop l m2
                 | otherwise   = loop m1 r
            where
                m1 = (l*2+r) `div` 3
                m2 = (l+r*2) `div` 3

itof :: Int -> Double
itof = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List

main = do
    [n,m,d] <- map read . words <$> getLine
    l <- replicateM n (map read . words <$> getLine)
    print $ solve n m d (join l)

solve :: Int -> Int -> Int -> [Int] -> Int
solve n m d l | check     = minimum [ sum [ abs (x-b) `div`   d | b <- l],
                                      sum [ abs (x-d-b) `div` d | b <- l],
                                      sum [ abs (x+d-b) `div` d | b <- l]]
              | otherwise = -1
    where
        a       = head l
        check   = and [ (a - b) `mod` d == 0 | b <- l ]
        avg     = sum (map itof l) / itof (n*m)
        x       = snd $ minimum [ (abs (itof a+itof k* itof d-avg),a+k*d) | k <- [-10000..10000]]

itof :: Int -> Double
itof = fromIntegral

import Control.Applicative
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B

main = B.interact $ showBI . rd . B.lines
rd (nmd:mat) = go (readBI <$> B.words nmd) (concat $ map readBI <$> B.words <$> mat)
go (_:_:d:[]) mt | (alleq $ (`mod`d) <$> mt) == True = g . f $ dv
                 | otherwise                         = -1
                                                       where g x = sum $ (abs . (x`subtract`)) <$> dv
                                                             dv = (`div`d) <$> mt
f x = minimum $ (\y -> maximum $ (\z -> abs (y-z)) <$> x) <$> [1..10^4]
alleq (x:[]) = True
alleq (x:y:xs) = (x==y)&&(alleq (y:xs))

showBI :: Int -> B.ByteString
showBI = B.pack . show

readBI :: B.ByteString -> Int
readBI = fst . fromJust . B.readInt

import Control.Applicative
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B

main = B.interact $ showBI . rd . B.lines
rd (nmd:mat) = go (readBI <$> B.words nmd) (concat $ map readBI <$> B.words <$> mat)
go (_:_:d:[]) mt | (alleq $ (`mod`d) <$> mt) == True = (`div`d) . f . sort $  mt
                 | otherwise                         = -1
f x = g 0 (length x) 0 (sum x) x
      where g ll _ ls _ [] = ll*ls
            g ll rl ls rs (y:ys) = (abs (ll*y-ls) + abs (rl*y-rs))`min`(g (ll+1) (rl-1) (ls+y) (rs-y) ys)
alleq (x:[]) = True
alleq (x:y:xs) = (x==y)&&(alleq (y:xs))

showBI :: Int -> B.ByteString
showBI = B.pack . show

readBI :: B.ByteString -> Int
readBI = fst . fromJust . B.readInt


import Data.List
main = interact $ solve.map read.drop 1.words
solve xs=show $ solve' xs 0
	where solve' [] _ = 0
              solve' xs h = min (length xs) $ (solve' l h') + (solve' (tail r) h') + h'- h
		  where h' = minimum xs
		  	(l,r)=break (==h') xs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.DeepSeq
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: [Int] -> Int
solve xs = f xs
   where
     split xs = case dropWhile (0==) xs of
                  [] -> []
                  ys -> case span (0/=) ys of
                          (zs,ws) -> zs : split ws
     f [x] = 1
     f xs
       | m >= l = l
       | otherwise = case foldl' (\acc x->acc+f x) 0 . split $ map (subtract m) xs of
                       res -> case min l (m + res) of {x -> x}
      where
        !m = minimum xs
        !l = length xs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import Data.Word
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> [Int] -> Int
solve n xs = f 0 (0,n-1)
   where
     !arr = listArray (0,n-1) xs :: UArray Int Int
     !rmq = mkRMQ xs
     split :: Int -> (Int, Int) ->[(Int,Int)]
     split !h (l0,r0) = go [l0..r0]
      where
        go is = case dropWhile (\i->unsafeAt arr i <= h) is of
                  is'@(_:_) -> case span (\i->unsafeAt arr i>h) is' of
                                 ((l:_),(r:rs)) -> (l,r-1):go rs
                                 ((l:_),[]) -> [(l,r0)]
                  [] -> []
     f !h (!l,!r) = min (r - l + 1) $ m - h + foldl' (\acc lr->acc+f m lr) 0 (split m (l,r))
      where
        !m = query rmq l r

type RMQ = UArray (Int,Int) Int

mkRMQ :: [Int] -> RMQ
mkRMQ xs = runSTUArray $ do
  let !n = length xs
  rmq <- newArray_ ((0,0),(log2 n,n-1)) :: ST s (STUArray s (Int,Int) Int)
  let go !i (x:xs) = unsafeWrite rmq i x >> go (i+1) xs
      go _ _ = return ()
  go 0 xs
  forM_ [1..log2 n] $ \logk -> do
    forM_ [(logk-1)*n..(logk-1)*n+n-1] $ \ki -> do
      unsafeRead rmq ki >>= unsafeWrite rmq (ki+n)
    let !k = 1 .<<. (logk-1)
    rep (n-k) $ \i -> do
      xi  <- unsafeRead rmq $ logk*n+i
      xik <- unsafeRead rmq $ logk*n+i+k
      when (xik < xi) $ do
        unsafeWrite rmq (logk*n+i) xik
  return rmq

query :: RMQ -> Int -> Int -> Int
query rmq l r = (rmq!(log2d, l)) `min` (rmq!(log2d, r - (1 .<<. log2d) + 1))
   where
     !log2d = log2 $ r - l
{-# INLINE query #-}

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

log2 :: Int -> Int
log2 x = unsafeAt magic32 . fromIntegral $ (e * 0x07c4acdd) .>>. 27
   where
     w :: Word
     w = fromIntegral x
     !a = w .|. (w .>>. 1)
     !b = a .|. (a .>>. 2)
     !c = b .|. (b .>>. 4)
     !d = c .|. (c .>>. 8)
     !e = d .|. (d .>>. 16)

magic32 :: UArray Int Int
magic32 = listArray (0,31) [  0,  9,  1, 10, 13, 21,  2, 29
                           , 11, 14, 16, 18, 22, 25,  3, 30
                           ,  8, 12, 20, 28, 15, 17, 24,  7
                           , 19, 27, 23,  6, 26,  5,  4, 31
                           ]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import Data.Word
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> [Int] -> Int
solve n xs = f 0 $ zip[0..]xs
   where
     !rmq = mkRMQ xs
     split !h ixs = case dropWhile ((h==).snd) ixs of
                  [] -> []
                  ys -> case span ((h/=).snd) ys of
                          (zs,ws) -> zs : split h ws
     f !h ixs@((i,_):_) = res
      where
        !l = length ixs
        !m = query rmq i (i+l-1)
        !merged = foldl' (\acc ix->acc+f m ix) 0 $ split m ixs
        !res = min l (m - h + merged)

type RMQ = UArray (Int,Int) Int

mkRMQ :: [Int] -> RMQ
mkRMQ xs = runSTUArray $ do
  let !n = length xs
  rmq <- newArray_ ((0,0),(log2 n,n-1)) :: ST s (STUArray s (Int,Int) Int)
  let go !i (x:xs) = unsafeWrite rmq i x >> go (i+1) xs
      go _ _ = return ()
  go 0 xs
  forM_ [1..log2 n] $ \logk -> do
    forM_ [(logk-1)*n..(logk-1)*n+n-1] $ \ki -> do
      unsafeRead rmq ki >>= unsafeWrite rmq (ki+n)
    let !k = 1 .<<. (logk-1)
    rep (n-k) $ \i -> do
      xi  <- unsafeRead rmq $ logk*n+i
      xik <- unsafeRead rmq $ logk*n+i+k
      when (xik < xi) $ do
        unsafeWrite rmq (logk*n+i) xik
  return rmq

query :: RMQ -> Int -> Int -> Int
query rmq l r = (rmq!(log2d, l)) `min` (rmq!(log2d, r - (1 .<<. log2d) + 1))
   where
     !log2d = log2 $ r - l
{-# INLINE query #-}

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

log2 :: Int -> Int
log2 x = unsafeAt magic32 . fromIntegral $ (e * 0x07c4acdd) .>>. 27
   where
     w :: Word
     w = fromIntegral x
     !a = w .|. (w .>>. 1)
     !b = a .|. (a .>>. 2)
     !c = b .|. (b .>>. 4)
     !d = c .|. (c .>>. 8)
     !e = d .|. (d .>>. 16)

magic32 :: UArray Int Int
magic32 = listArray (0,31) [  0,  9,  1, 10, 13, 21,  2, 29
                           , 11, 14, 16, 18, 22, 25,  3, 30
                           ,  8, 12, 20, 28, 15, 17, 24,  7
                           , 19, 27, 23,  6, 26,  5,  4, 31
                           ]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import Data.Word
import GHC.Arr (Array, Ix, unsafeIndex)
import Unsafe.Coerce
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> [Int] -> Int
solve n xs = f 0 (0,n-1)
   where
     !arr = listArray (0,n-1) xs :: UArray Int Int
     !rmq = mkRMQ xs
     split :: Int -> (Int, Int) ->[(Int,Int)]
     split !h (l0,r0) = go $ until (\i -> i<=r0 && unsafeAt arr i/=h || r0 < i) (1+) l0
      where
        go !i
          | i<=r0 && j<=r0 = (i,j) : go (until (\i -> i<=r0 && unsafeAt arr i/=h || r0 < i) (1+) $ j+1)
          | otherwise = []
         where
           !j = min r0 . subtract 1 $ until (\i -> i<=r0 && unsafeAt arr i==h || r0<i) (1+) i
     f !h (!l,!r) = min (r - l + 1) $ m - h + foldl' (\acc lr->acc+f m lr) 0 (split m (l,r))
      where
        !m = query rmq l r

type RMQ = UArray (Int,Int) Int

mkRMQ :: [Int] -> RMQ
mkRMQ xs = runSTUArray $ do
  let !n = length xs
  rmq <- newArray_ ((0,0),(log2 n,n-1)) :: ST s (STUArray s (Int,Int) Int)
  let go !i (x:xs) = unsafeWrite rmq i x >> go (i+1) xs
      go _ _ = return ()
  go 0 xs
  forM_ [1..log2 n] $ \logk -> do
    forM_ [(logk-1)*n..(logk-1)*n+n-1] $ \ki -> do
      unsafeRead rmq ki >>= unsafeWrite rmq (ki+n)
    let !k = 1 .<<. (logk-1)
    rep (n-k) $ \i -> do
      xi  <- unsafeRead rmq $ logk*n+i
      xik <- unsafeRead rmq $ logk*n+i+k
      when (xik < xi) $ do
        unsafeWrite rmq (logk*n+i) xik
  return rmq

query :: RMQ -> Int -> Int -> Int
query rmq l r = (rmq!(log2d, l)) `min` (rmq!(log2d, r - (1 .<<. log2d) + 1))
   where
     !log2d = log2 $ r - l
{-# INLINE query #-}

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

log2 :: Int -> Int
log2 x = unsafeAt magic32 . unsafeCoerce $ (e * 0x07c4acdd) .>>. 27
   where
     w :: Word
     w = unsafeCoerce x
     !a = w .|. (w .>>. 1)
     !b = a .|. (a .>>. 2)
     !c = b .|. (b .>>. 4)
     !d = c .|. (c .>>. 8)
     !e = (d .|. (d .>>. 16))
{-# INLINE log2 #-}

magic32 :: UArray Int Int
magic32 = listArray (0,31) [  0,  9,  1, 10, 13, 21,  2, 29
                           , 11, 14, 16, 18, 22, 25,  3, 30
                           ,  8, 12, 20, 28, 15, 17, 24,  7
                           , 19, 27, 23,  6, 26,  5,  4, 31
                           ]

main = interact $ show . solve . map read . tail . words
solve :: [Int] -> Int
solve = solve' 0
    where solve' _ [] = 0
          solve' h xs = min (length xs) $ solve' h' l + solve' h' (tail r) + h' - h
            where h' = minimum xs
                  (l, r) = break (==h') xs

isolve :: [Int] -> Int
-- solve when all elems are positive
isolve [] = 0
isolve li = let
  q = minimum li
  redAns = q + solve (map (subtract q) li)
  in  min (length li) redAns

solve :: [Int] -> Int
-- solve in general: O(n*n).
solve [] = 0
solve li = let
  (pos, rest) = span (> 0) li
  in  isolve pos + solve (dropWhile (== 0) rest)

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

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.concat.map (map read.words).take 2. lines
solve :: [Integer]-> String
solve (x:xs) = show $  slv1 (x:xs)
slv1 [] = 0
slv1 (x:xs)= minimum [x, mi + sum [slv1 y|y<-ff]]
  where
  ff=foldr (f) [[]] $ map (\a->a-mi) xs
  mi          = minimum xs
  f 0 [[]]    = [[]]
  f 0 ([]:bs) = ([]:bs)
  f 0 bs      = ([]:bs)
  f a [[]]    = [[1,a]]
  f a ([]:bs) = ([1,a]:bs)
  f a ((b:bs):bss)  = ((b+1:a:bs):bss)

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
readLine = BS8.getLine >>= return . map readInt . BS8.words

trimZero list
  | length list == 0 = list
  | head list == 0 = trimZero (tail list)
  | otherwise = list

paint planks = min (length planks) (f planks)
  where f _planks
          | length _planks == 0 = 0
          | length _planks == 1 = 1
          | otherwise = minValue + (paint first) + paint (trimZero second)
          where minValue = minimum _planks
                (first, second) = break (== 0) $ map (subtract minValue) _planks

main = do
   [_] <- readLine
   planks <- readLine
   print $ paint planks

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  n <- readLn
  ns <- getInts

  let arr = listArray (0, n-1) ns :: UArray Int Int

      go !l !r !h
        | w <= 1 = w
        | otherwise = min w $ (minh - h) + sum (map (\(a, b) -> go a b minh) $ filter nonnull $ spans l l)
        where
          w = r - l
          minh = foldl1' min $ map (arr!) [l..r-1]
          nonnull (a, b) = a /= b

          spans s i
            | i == r = [(s, i)]
            | arr!i == minh = (s, i) : spans (i+1) (i+1)
            | otherwise = spans s (i+1)

  print $ go 0 n 0

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
  width:_ <- readLine
  heights <- readLine
  B.putStrLn . B.pack . show $ paintTheWall width heights

paintTheWall :: Int -> [Int] -> Int
paintTheWall 0 _ = 0
paintTheWall 1 _ = 1
paintTheWall width heights = min width $ (+ minHeight) $ sum $ map (\h -> paintTheWall (length h) h) $ splitByZero $ map (\x -> x - minHeight) heights
  where minHeight = minimum heights

splitByZero :: [Int] -> [[Int]]
splitByZero = foldr takeTillZero [[]]

takeTillZero :: Int -> [[Int]] -> [[Int]]
takeTillZero n agg@(x:xs)
  | null agg = error "WTF"
  | and [n == 0, null x] = agg
  | n == 0 = []:agg
  | otherwise = (n:x):xs

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Function (on)
import Data.List (groupBy)

readInt = fromIntegral . fst . fromJust . B.readInteger

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

solve [] [] = 0
solve [(n, h, s)] [] = min n (h + s)
solve ((n, h, s) : (n2, h2, s2) : stack) [] =
  solve ((n2 + n, h2, s2 + (min n (h - h2 + s))) : stack) []
solve [] (plank : fence) =
  solve [(1, plank, 0)] fence
solve ((n, h, s) : stack) (plank : fence) =
  if plank > h then
    solve ((1, plank, 0) : (n, h, s) : stack) fence
  else if plank == h then
    solve ((n + 1, h, s) : stack) fence
  else if stack == [] then
    solve [(n + 1, plank, min n (h - plank + s))]
          fence
  else
    let (n2, h2, s2) = head stack
    in
      if h2 >= plank then
        solve ((n2 + n, h2, s2 + min n (h - h2 + s)) : tail stack)
              (plank : fence)
      else
        solve ((n + 1, plank, min n (h - plank + s)) : stack)
              fence

oldSolve planks =
  let
     min = if planks == [] then 0 else minimum planks
  in
    if min >= length planks then
      length planks
    else
      (+ min) .
      sum .
      map oldSolve .
      filter ((/= 0) . head) .
      groupBy ((==) `on` (== 0)) .
      map (flip (-) min) $ planks

check fenceRaw =
  let fence = map ((+1) . abs) fenceRaw
  in oldSolve fence == solve [] fence

main = do
  _ <- readLine
  planks <- readLine
  B.putStrLn . B.pack . show $ solve [] planks

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  n <- readLn
  ns <- getInts

  let arr = listArray (0, n-1) ns :: UArray Int Int

      go !l !r !h
        | w <= 1 = w
        | otherwise = min w $ (minh - h) + sum (map (\(a, b) -> go a b minh) $ filter nonnull $ spans 0 0)
        where
          w = r - l
          minh = foldl1' min $ map (arr!) [l..r-1]
          nonnull (a, b) = a /= b

          spans s i
            | i == r = [(s, i)]
            | arr!i == minh = (s, i) : spans (i+1) (i+1)
            | otherwise = spans s (i+1)

  print $ go 0 n 0

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Function (on)
import Data.List (groupBy)

readInt = fromIntegral . fst . fromJust . B.readInteger

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

solve [] [] = 0
solve [(n, h)] [] = min n h
solve ((n, h) : (n2, h2) : stack) [] =
  min n h + solve ((n2 + n, h2) : stack) []
solve [] (plank : fence) =
  solve [(1, plank)] fence
solve ((n, h) : stack) (plank : fence) =
  if plank > h then
    solve ((1, plank) : (n, h) : stack) fence
  else if plank == h then
    solve ((n + 1, h) : stack) fence
  else if stack == [] then
    min n (h - plank) +
      solve [(n + 1, plank)] fence
  else
    let (n2, h2) = head stack
    in
      min n (h - h2) +
        solve ((n2 + n, h2) : tail stack) (plank : fence)

main = do
  _ <- readLine
  planks <- readLine
  B.putStrLn . B.pack . show $ solve [] planks

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Function (on)
import Data.List (groupBy)

readInt = fromIntegral . fst . fromJust . B.readInteger

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

solve [] [] = 0
solve [(n, h)] [] = min n h
solve ((n, h) : (n2, h2) : stack) [] =
  min n h + solve ((n2 + n, h2) : stack) []
solve [] (plank : fence) =
  solve [(1, plank)] fence
solve ((n, h) : stack) (plank : fence) =
  if plank > h then
    solve ((1, plank) : (n, h) : stack) fence
  else if plank == h then
    solve ((n + 1, h) : stack) fence
  else if stack == [] then
    min n (h - plank) +
      solve [(n + 1, plank)] fence
  else
    let (n2, h2) = head stack
    in
      if h2 >= plank then
        min n (h - h2) +
          solve ((n2 + n, h2) : tail stack) (plank : fence)
      else
        min n (h - plank) +
          solve ((n + 1, plank) : stack) fence

main = do
  _ <- readLine
  planks <- readLine
  B.putStrLn . B.pack . show $ solve [] planks

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Function (on)
import Data.List (groupBy)

readInt = fromIntegral . fst . fromJust . B.readInteger

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

solve [] [] = 0
solve [(n, h, s)] [] = min n (h + s)
solve ((n, h, s) : (n2, h2, s2) : stack) [] =
  solve ((n2 + n, h2, s2 + (min n (h + s))) : stack) []
solve [] (plank : fence) =
  solve [(1, plank, 0)] fence
solve ((n, h, s) : stack) (plank : fence) =
  if plank > h then
    solve ((1, plank, 0) : (n, h, s) : stack) fence
  else if plank == h then
    solve ((n + 1, h, s) : stack) fence
  else if stack == [] then
    solve [(n + 1, plank, min n (h - plank + s))]
          fence
  else
    let (n2, h2, s2) = head stack
    in
      if h2 >= plank then
        solve ((n2 + n, h2, s2 + min n (h - h2 + s)) : tail stack)
              (plank : fence)
      else
        solve ((n + 1, plank, min n (h - plank + s)) : stack)
              fence

oldSolve planks =
  let
     min = if planks == [] then 0 else minimum planks
  in
    if min >= length planks then
      length planks
    else
      (+ min) .
      sum .
      map oldSolve .
      filter ((/= 0) . head) .
      groupBy ((==) `on` (== 0)) .
      map (flip (-) min) $ planks

check fenceRaw =
  let fence = map ((+1) . abs) fenceRaw
  in oldSolve fence == solve [] fence

main = do
  _ <- readLine
  planks <- readLine
  B.putStrLn . B.pack . show $ solve [] planks

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: [Int] -> Int
solve xs = f xs
   where
     split xs = case dropWhile (0==) xs of
                  [] -> []
                  ys -> case span (0/=) ys of
                          (zs,ws) -> zs : split ws
     f [x] = 1
     f [] = 0
     f xs = m + sum (map f . split $ map (subtract m) xs)
      where
        m = minimum xs


import qualified Data.ByteString.Char8 as B
main = getLine >> B.getLine >>= print . solve
solve bs
  | i==0 = a
  | i==1 = 1
  | otherwise = 0
   where
     a = B.count 'A' bs
     i = B.count 'I' bs

main :: IO ()
main = do
  _ <- getLine
  statuses <- getLine
  let is = length $ filter (== 'I') statuses
      as = length $ filter (== 'A') statuses

  print $ if is > 1
            then 0
            else if is == 1
                  then 1
                  else as

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    B.getLine
    s <- B.getLine
    print $ solve s

solve :: B.ByteString -> Int
solve s = if i == 0 then a else if i == 1 then 1 else 0
    where
        (a,i,f) = B.foldl g (0,0,0) s
        g (a,i,f) 'A' = (a+1,i,f)
        g (a,i,f) 'I' = (a,i+1,f)
        g (a,i,f) 'F' = (a,i,f+1)
        g s _ = s

import Data.List

solve :: String -> Int
solve xs = foldl' toShow 0 xs
  where
    toShow x 'A' | in_count == 0 = x + 1
    toShow x 'I' | in_count == 1 = x + 1
    toShow x _ = x
    in_count = length $ filter ('I'==) xs

main = interact $ show . solve . concat . tail . words

solve :: String -> Int
solve s
  | i == 0  =  a
  | i == 1  =  1
  | otherwise  =  0
  where
    a  =  length $ filter (== 'A') s
    i  =  length $ filter (== 'I') s

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

-- Codeforces 284B

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= print . solve

solve :: String -> Int
solve xs = case cnt_I
    of {
        0 -> cnt_A;
        1 -> 1;
        otherwise -> 0;
    }where
        cnt_I = length $ filter (== 'I') xs
        cnt_A = length $ filter (== 'A') xs

data Статус = ALLIN | IN | FOLDED deriving (Eq)
main = do
    s1 <- getLine
    s2 <- getLine
    let коровки = map toСтатус s2
    print $ решить коровки

toСтатус 'A' = ALLIN
toСтатус 'I' = IN
toСтатус 'F' = FOLDED

решить коровки | inCount == 0 = length $ filter (==ALLIN) коровки
               | inCount == 1 = 1
               | otherwise = 0
               where inCount = length $ filter (==IN) коровки

main = do
    _ <- getLine
    b <- getLine
    putStr $ show $ case length (filter (== 'I') b) of
        0 -> length (filter (== 'A') b)
        1 -> 1
        _ -> 0

main = do
    getLine
    l <- getLine
    putStrLn $ if (elem 'I' l) then (if (count 'I' l == 1) then "1" else "0") else (show . count 'A' $ l)
        where
            count c = length . filter (==c)

solve :: String -> Int
solve s
  | i == 0  =  a
  | i == 1  =  1
  | otherwise  =  0
  where
    a  =  length $ filter (== 'A') s
    i  =  length $ filter (== 'I') s

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

main = do
    a <- getLine
    b <- getLine
    putStr $ show $ if length (filter (== 'I') b) == 1 then 1 else length (filter (== 'A') b)

main = do
    getLine
    l <- getLine
    putStrLn $ if (elem 'I' l) then (show (max (count 'I' l) 1)) else (show . count 'A' $ l)
        where
            count c = length . filter (==c)

main = do
    getLine
    l <- getLine
    putStrLn $ if (elem 'I' l) then "1" else (show . length . filter (=='A') $ l)


import List
g[]=[[],[]]
g((_,a):b)=(\[x,y]->[y,a:x])$g b
p x=[show$length x,unwords$map show x]
main=interact$unlines.(>>=p).g.sort.(`zip`[1..]).map((+0).read).tail.words

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

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

solve :: [(Int, Int)] -> (([Int],Int),([Int],Int)) -> ([Int],[Int])
solve []  ((a,_),(b,_)) = (a,b)
solve [(xp,xn)] ((a,as),(b,bs))
   | as < bs   = (xn:a, b)
   | otherwise = (a, xn:b)
solve ((xp,xn):(yp,yn):zz) ((a,as),(b,bs))
   | as < bs   = solve zz ((xn:a, as + xp), (yn:b, bs + yp))
   | otherwise = solve zz ((yn:a, as + yp), (xn:b, bs + xp))

p xs = do
   print $ length xs
   putStrLn . concat . intersperse " " $ map show xs

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n = readInt $ head input
       xs = reverse . sort . flip zip [1..] . readIntList $ input !! 1
   let (ansx, ansy) = solve xs (([], 0), ([], 0))
   p ansx
   p ansy

-- vim: set expandtab:

import Control.Monad
import Data.List
part [] accum = accum
part [b] (v1, t1, v2, t2) = if v1 < v2 then (v1 + fst b, snd b : t1, v2, t2)
                                       else (v1, t1, v2 + fst b, snd b : t2)
part (b1:b2:bs) (v1, t1, v2, t2) =
  if (v1 < v2 && fst b1 < fst b2) || (v1 > v2 && fst b1 > fst b2)
  then part bs (v1 + fst b2, snd b2 : t1, v2 + fst b1, snd b1 : t2)
  else part bs (v1 + fst b1, snd b1 : t1, v2 + fst b2, snd b2 : t2)
main = do
  n <- (liftM read) getLine
  skills <- (liftM $ reverse . sort . flip zip [1..n] . (map read) . words) getLine
  let (v1, t1, v2, t2) = part skills (0, [], 0, [])
  putStrLn . show $ length t1
  putStrLn . unwords $ map show t1
  putStrLn . show $ length t2
  putStrLn . unwords $ map show t2

import Data.List

solve :: [Int] -> [[Int]]
solve (n:xs) = [[length evens], evens, [length odds], odds]
    where
        summary = sortBy (\(a,b) (c,d) -> compare a c) $ zip xs $ iterate (+1) 1
        (evens, odds) = split summary [] [] 1
        split [] es os _ = (es, os)
        split ((x, p):xs) es os i   | even i = split xs (p:es) os $ i + 1
                                    | odd i = split xs es (p:os) $ i + 1

main = do
    input <- getContents
    sequence_ $ map (putStrLn.show) $ concat $ solve.map read.words $ input

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate, sortBy)
import Prelude hiding (reads)

reads :: IO [Int]
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 + ord c - ord '0'

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

solve :: [Int] -> ([Int], [Int])
solve as  =  (map (fst . snd) one, map (fst . snd) two)
  where
    one  =  filter (odd . fst) sorted
    two  =  filter (even . fst) sorted
    sorted  =  zip [1..] $ sortBy compare' $ zip [1..] as
    compare' a b  =  compare (snd a) (snd b)

main :: IO ()
main  =  do
    getLine
    as  <-  reads
    prints $ fst $ solve as
    prints $ snd $ solve as

import Data.List

solve bs = foldl' makeChoice (0, [], 0, []) $  sortBy (\(_, a) (_, b) -> compare a b) $ zip [1 .. ] bs
  where makeChoice (x, xs, y, ys) (i, a)
          | x <= y    = (x + a, i : xs, y, ys)
          | otherwise = (x, xs, y + a, i : ys)

main = do _  <- getLine
          bs <- fmap (map read . words) getLine

          let (x, xs, y, ys) = solve bs

          putStrLn $ show $ length xs
          putStrLn $ unwords $ map show xs

          putStrLn $ show $ length ys
          putStrLn $ unwords $ map show ys

import Data.Ord
import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do n <- read <$> getLine
          xs <- map read' <$> B.words <$> B.getLine
          putStrLn $ unlines $ map (unwords . map show) $ solve n xs

read' s = let Just (n,_) = B.readInt s
          in n

solve :: Int -> [Int] -> [[Int]]
solve n xs = solve' (0,0) (0,0) ([],[]) $ sortBy (comparing snd) $ zip [1..] xs

solve' :: (Int,Int) -> (Int,Int) -> ([Int],[Int]) -> [(Int,Int)] -> [[Int]]
solve' (ix,iy) (sx,sy) (xs,ys) [] = [[ix],xs,[iy],ys]
solve' (ix,iy) (sx,sy) (xs,ys) ((i,n):ns)
  | sx == sy && ix <= iy = solve' (ix+1,iy) (sx+n,sy) (i:xs,ys) ns
  | sx == sy             = solve' (ix,iy+1) (sx,sy+n) (xs,i:ys) ns
  | sx < sy              = solve' (ix+1,iy) (sx+n,sy) (i:xs,ys) ns
  | sx > sy              = solve' (ix,iy+1) (sx,sy+n) (xs,i:ys) ns

import Data.List
import Data.Map hiding(map,filter)
import Data.Function

left (ls,rs) x = (x:ls,rs)
right (ls,rs) x = (ls,x:rs)

division = left:cycle [right,right,left,left]

result :: [[Int]]->[[Int]]
result [_,xs] = [[length (fst res)],fst res,[length (snd res)],snd res]
	where
	sortedIndexes = map fst.reverse.sortBy (compare `on` snd)$zip [1..] xs
	f a (d,x) = d a x
	res = foldl f ([],[]) (zip division sortedIndexes)

main=interact$unlines.map (unwords.map show).result.map (map read.words).lines

import List
g(_,a)[x,y]=[y,a:x]
p x=[[length x],x]
main=interact$unlines.map(unwords.map show).(>>=p).foldr g[[],[]].sort.(`zip`[1..]).map((+0).read).tail.words

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

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

solve :: [(Int, Int)] -> (([Int],Int),([Int],Int)) -> ([Int],[Int])
solve []  ((a,_),(b,_)) = (a,b)
solve [(xn,xp)] ((a,as),(b,bs))
   | as < bs   = (xn:a, b)
   | otherwise = (a, xn:b)
solve ((xn,xp):(yn,yp):zz) ((a,as),(b,bs))
   | as < bs   = solve zz ((xn:a, as + xp), (yn:b, bs + yp))
   | otherwise = solve zz ((yn:a, as + yp), (xn:b, bs + xp))

p xs = do
   print $ length xs
   putStrLn . concat . intersperse " " $ map show xs

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n = readInt $ head input
       xs = reverse . sort . zip [1..] . readIntList $ input !! 1
   let (ansx, ansy) = solve xs (([], 0), ([], 0))
   p ansx
   p ansy

-- vim: set expandtab:

import Data.List

solve :: [Int] -> [[Int]]
solve (k:xs) = [[length evens], evens, [length odds], odds]
    where
        summary = sortBy (\(a,b) (c,d) -> compare a b) $ zip xs $ iterate (+1) 1
        (_, odds) = unzip $ filter (\(a, b) -> odd b) $ summary
        (_, evens) = unzip $ filter (\(a, b) -> even b) $ summary

main = do
    input <- getLine
    sequence_ $ map (putStrLn.show) $ concat $ solve.map read.words $ input

import Data.List

solve :: [Int] -> [[Int]]
solve (k:xs) = [[length evens], evens, [length odds], odds]
    where
        summary = sortBy (\(a,b) (c,d) -> compare a b) $ zip xs $ iterate (+1) 1
        (_, odds) = unzip $ filter (\(a, b) -> odd b) $ summary
        (_, evens) = unzip $ filter (\(a, b) -> even b) $ summary

main = do
    input <- getContents
    sequence_ $ map (putStrLn.show) $ concat $ solve.map read.words $ input

import Data.List

solve :: [Int] -> [[Int]]
solve (n:xs) = [[length evens], evens, [length odds], odds]
    where
        summary = sortBy (\(a,b) (c,d) -> compare a b) $ zip xs $ iterate (+1) 1
        (evens, odds) = split summary [] [] 1
        split [] es os _ = (es, os)
        split ((x, p):xs) es os i   | even i = split xs (p:es) os $ i + 1
                                    | odd i = split xs es (p:os) $ i + 1

main = do
    input <- getContents
    sequence_ $ map (putStrLn.show) $ concat $ solve.map read.words $ input

import Data.List

solve bs = foldl' makeChoice (0, [], 0, []) $ zip [1 .. ] $ sort bs
  where makeChoice (x, xs, y, ys) (i, a)
          | x <= y    = (x + a, i : xs, y, ys)
          | otherwise = (x, xs, y + a, i : ys)

main = do _  <- getLine
          bs <- fmap (map read . words) getLine

          let (_, xs, _, ys) = solve bs

          putStrLn $ show $ length xs
          putStrLn $ unwords $ map show xs

          putStrLn $ show $ length ys
          putStrLn $ unwords $ map show ys

import Data.List

solve bs = foldl' makeChoice (0, [], 0, []) $ zip [1 .. ] bs
  where makeChoice (x, xs, y, ys) (i, a)
          | x <= y    = (x + a, i : xs, y, ys)
          | otherwise = (x, xs, y + a, i : ys)

main = do _  <- getLine
          bs <- fmap (map read . words) getLine

          let (_, xs, _, ys) = solve bs

          putStrLn $ show $ length xs
          putStrLn $ unwords $ map show xs

          putStrLn $ show $ length ys
          putStrLn $ unwords $ map show ys


module Main where
import Control.Applicative
import Data.List
import Data.Function

main = do
    n <- readLn :: IO Int
    as <- map (read :: String -> Int) . words <$> getLine
    m <- readLn :: IO Int
    bs <- map (read :: String -> Int) . words <$> getLine
    print $ length $ maximumBy (compare `on` head) $ group $ sort [y`div`x | x<-as, y <-bs, y`mod`x==0]

import Prelude hiding (reads)

countMaximums :: [Int] -> Int
countMaximums []  =  0
countMaximums xs  =  length $ filter (== maximum xs) xs

solve :: [Int] -> [Int] -> Int
solve as bs  =  countMaximums [div b a | a <- as, b <- bs, mod b a == 0]

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

main :: IO ()
main  =  do
    as <- getLine >> reads
    bs <- getLine >> reads
    print $ solve as bs

import Data.List
import Data.Maybe
import Control.Monad
main = do
  getLine
  as <- fmap (map read . words) getLine
  getLine
  bs <- fmap (map read . words) getLine
  print $ length $ last $ group $ sort $ catMaybes $ liftM2 solve as bs
solve a b | r == 0    = Just q
          | otherwise = Nothing
    where (q,r) = b `divMod` a

import Data.List
import Data.Char

solve = length . head . group . reverse . sort
s2i = foldl t 0
        where t i c = i * 10 + digitToInt c

main = do
        ln <- getLine >> getLine >>= return . map s2i . words
        lm <- getLine >> getLine >>= return . map s2i . words
        let l = [ fst (j `quotRem` i) |  i <- ln, j <- lm, snd (j `quotRem` i) == 0  ] in
                print (solve l)

import Control.Applicative

main = do
  _ <- getLine
  as <- map read.words <$> getLine
  _ <- getLine
  bs <- map read.words <$> getLine
  let ints = [q|a<-as,b<-bs,let (q,r) = divMod b a,r==0]
  print $ length $ filter (maximum ints==) ints

import Data.List
main = do
    n <- read `fmap` getLine :: IO Int
    a <- (map read . words) `fmap` getLine
    m <- read `fmap` getLine :: IO Int
    b <- (map read . words) `fmap` getLine
    print $ length $ last $ group $ sort [x `div` y |  x <- b, y <- a, x `rem` y == 0]

import Data.List

solve :: ([Int], [Int]) -> Int
solve (xs, ys) = length . last . group $ sort [y `div` x | x <- xs, y <- ys, y `mod` x == 0]

readInput :: IO ([Int], [Int])
readInput = do
    contents <- getContents
    let n:ns:m:ms:_ = lines contents
        xs = map read $ take (read n) $ words ns
        ys = map read $ take (read m) $ words ms
    return (xs, ys)

showOutput :: Int -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

import Control.Monad

main :: IO ()
main = do
    n <- getLine
    ns <- fmap (map read . words) getLine :: IO [Int]
    m <- getLine
    ms <- fmap (map read . words) getLine :: IO [Int]

    let a = [div x y | x <- ms, y <- ns, mod x y == 0]

    print $ length $ filter (maximum a == ) a

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

parse = map (map read) . map words . lines

solve :: [[Int]] -> Int
solve [_, as, _, bs] =
  let
    bestRatio = maximum [b `div` a | b <- bs, a <- as, b `mod` a == 0]
  in
    length [8 | b <- bs, a <- as, b `mod` a == 0, b `div` a == bestRatio]

present = show

main = interact $ present . solve . parse

main = do
  getLine
  a <- fmap (map read . words) getLine
  getLine
  b <- fmap (map read . words) getLine
  print $ gao a b
  where
    gao a b = length $ filter (==maximum c) c
      where
        c = [div j i | i <- a, j <- b, mod j i == 0]

combination::[Int]->[Int]->[(Int,Int)]
combination [] _ = []
combination (x:xs) ys = [(x,yy) | yy <- ys] ++ combination xs ys

getMax::[(Int,Int)] -> Int
getMax [] = 0
getMax (x:xs)
       | (((snd x) `mod` (fst x)) == 0) = max ((snd x) `div` (fst x)) (getMax xs)
       | otherwise = max 0 (getMax xs)

count::[(Int,Int)] -> Int -> Int
count xs maxi = sum [1|x <- xs, ((snd x) `mod` (fst x)) == 0, ((snd x) `div` (fst x)) == maxi]

main = do
     _ <- getLine
     arg1 <- getLine
     let xs = map (read::String->Int) $ words arg1
     _ <- getLine
     arg2 <- getLine
     let ys = map (read::String->Int) $ words arg2
     let comb = combination xs ys
     let maxi = getMax comb
     putStrLn(show $ count comb maxi)

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

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

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

main = do
  getLine
  as <- getInts
  getLine
  bs <- getInts

  let
    m = maximum [b`div`a | b <- bs, a <- as, b`mod`a == 0]
    c = length $ [(a, b) | b <- bs, a <- as, b`mod`a == 0, b`div`a == m]

  print c

#! /usr/bin/runhaskell
import Data.List
main = do
  n <- readLn :: IO Int
  str <- getLine
  let a = map read (words str) :: [Int]
  m <- readLn :: IO Int
  str <- getLine
  let b = map read (words str) :: [Int]
  let list = f b a
  let m = maximum list
      c = length $ filter (==m) list
      in print c

f b a =
  if b == []
     then []
  else list ++ f (tail b) a
    where hb = head b
          list = map (\x -> hb `div` x) $ filter (\x -> hb `mod` x == 0) a

import Control.Applicative
import Data.List
-- Reduction ratio
rratio :: Int -> Int -> Maybe Int
rratio ifwd jbck =
    case m of 0 -> Just d
              _ -> Nothing
    where (d, m) = jbck `divMod` ifwd

maxby :: Maybe Int -> Maybe Int -> Ordering
maxby Nothing Nothing   = EQ
maxby Nothing _         = LT
maxby _ Nothing         = GT
maxby (Just x) (Just y) = compare x y

countmax :: [Int] -> [Int] -> Int
countmax ai bj =
    case mr of Nothing -> 0
               _ -> length $ filter (\x -> x == mr) rx
    where rx = rratio <$> ai <*> bj
          mr = maximumBy maxby rx

getInt x = read x :: Int

main = do
    n <- getLine
    ai <- fmap (map getInt . words) getLine
    m <- getLine
    bj <- fmap (map getInt . words) getLine
    print $ countmax ai bj

{-
Цепная передача Васиного велосипеда состоит из двух частей: n звездочек закреплены на оси педалей, а m звездочек — на оси заднего колеса. С помощью цепи вращение педалей передается на заднее колесо.

Известно, что i-ая звездочка на оси педалей имеет ai (0 < a1 < a2 < ... < an) зубьев, а j-ая звездочка на оси заднего колеса имеет bj (0 < b1 < b2 < ... < bm) зубьев. Любая пара (i, j) (1 ≤ i ≤ n; 1 ≤ j ≤ m) называется передачей и задает номера звездочек, на которых в данный момент закреплена цепь. Для передачи (i, j) передаточное число равно величине bj / ai.

Так как Васе нравятся целые числа, он хочет найти такие передачи (i, j), что их передаточные числа целые. С другой стороны, Васе нравится быстрая езда, поэтому среди всех «целочисленных» передач (i, j), он хочет выбрать передачи с максимальным передаточным числом. Помогите ему найти количество таких передач.

В задаче дробь bj / ai обозначает деление в вещественных числах, то есть округление не производится.
Входные данные

В первой строке входных данных записано целое число n (1 ≤ n ≤ 50) — количество звездочек на оси педалей велосипеда. Во второй строке записаны n целых чисел a1, a2, ..., an (1 ≤ ai ≤ 104) в порядке строгого возрастания.

В третьей строке входных данных записано целое число m (1 ≤ m ≤ 50) — количество звездочек на оси заднего колеса. В четвертой строке записаны m целых чисел b1, b2, ..., bm (1 ≤ bi ≤ 104) в порядке строгого возрастания.

Гарантируется, что существует хотя бы одна передача (i, j), что ее передаточное число — целое. Числа в строках разделяются пробелами.
Выходные данные

Выведите количество «целочисленных» передач, которые имеют максимальное значение передаточного числа среди всех «целочисленных» передач.

Примеры тестов
Входные данные

2
4 5
3
12 13 15

Выходные данные

2

Входные данные

4
1 2 3 4
5
10 11 12 13 14

Выходные данные

1

Примечание

В первом примере максимальное целое передаточное число равно 3. Существуют две передачи, которые имеют такое передаточное число. Для одной из них a1 = 4, b1 = 12, а для другой a2 = 5, b3 = 15.
-}

import Control.Applicative

solve a b = length [ 1 | aa <- a, bb <- b, bb `mod` aa == 0, bb `div` aa == mx ]
    where mx = foldl max 0 [ bb `div` aa | aa <- a, bb <- b, bb `mod` aa == 0 ]

main = do
  _ <- getLine
  a <- map read <$> (words <$> getLine)
  _ <- getLine
  b <- map read <$> (words <$> getLine)
  print $ solve a b

import Data.Maybe
import Control.Monad
main = do
  getLine
  as <- fmap (map read . words) getLine
  getLine
  bs <- fmap (map read . words) getLine
  print $ maximum $ catMaybes $ liftM2 solve as bs
solve a b | r == 0    = Just q
          | otherwise = Nothing
    where (q,r) = b `divMod` a

import Control.Monad

--main :: IO ()
main = do
    n <- getLine
    ns <- fmap (map read . words) getLine :: IO [Int]
    m <- getLine
    ms <- fmap (map read . words) getLine :: IO [Int]

    let a = [div x y | x <- ms, y <- ns, mod x y == 0]

    return $ length $ filter (maximum a == ) a


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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n,q],as] <- replicateM 2 ri
        return (q,as)
    mapM_ (putStrLn.solve) tcs

solve (q,as) = ans
  where
    minQs = reverse . tail . scanl nextQ 0 . reverse $ as
    ans = map snd . tail . scanl nextBit (q,'_') $ minQs `zip` as

nextQ q0 a1 | q0 >= a1   = q0
            | otherwise  = q0 +1

nextBit (q0,_) (mq,ai)
    | isF && isL  = (q0  , '0')
    | isF         = (q0  , '1')
    |        isL  = (q0-1, '1')
    | otherwise   = (q0  , '1')
  where
    isF = (q0 < mq)
    isL = (q0 < ai)

module Main where

solve :: Integer -> [Integer] -> String
solve n a = reverse $ solve' 0 n (reverse a) where
  solve' _ _ [] = []
  solve' a b (x : xs)
    | x <= a = '1' : solve' a b xs
    | otherwise = if a < b then '1' : solve' (a + 1) b xs else '0' : solve' a b xs

for :: Integer -> IO () -> IO ()
for n action = if n == 1 then action else action *> for (n - 1) action

main = do
  times <- read <$> getLine
  for times $ do
    n <- (read . (!!1) . words) <$> getLine
    list <- fmap (read) <$> words <$> getLine
    putStrLn $ solve n list


import Control.Monad
import Data.List

solve :: IO ()
solve = do
    getLine
    s <- transpose <$> sequence [getLine, getLine]
    let go ("01":xs)      = 2 + go xs
        go ("10":xs)      = 2 + go xs
        go ("00":"11":xs) = 2 + go xs
        go ("11":"00":xs) = 2 + go xs
        go ("00":xs)      = 1 + go xs
        go ("11":xs)      = go xs
        go ~[]            = 0
    print $ go s

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

import Control.Monad
import Data.List

calc :: [(Char,Char)] -> Int
calc [] = 0
calc [('0','1')] = 2
calc [('1','0')] = 2
calc [('0','0')] = 1
calc [('1','1')] = 0
calc (('0','1'):xs) = 2+(calc xs)
calc (('1','0'):xs) = 2+(calc xs)
calc (('0','0'):('1','1'):xs) = 2+(calc xs)
calc (('0','0'):xs) = 1+(calc xs)
calc (('1','1'):('0','0'):xs) = 2+(calc xs)
calc (('1','1'):xs) = (calc xs)

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

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

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 3 >>> map (tail >>> solve >>> show) >>> unlines

data State = SeenZero | SeenOne | None

solve :: [String] -> Int
solve [as, bs] = sum . map fst . scanl upd (0, None) $ zipWith val as bs ++ [3]
  where
    upd (_, st) v = compute v st

    compute 0 SeenZero = (1, SeenZero)
    compute 0 SeenOne  = (2, None)
    compute 0 None     = (0, SeenZero)
    compute 1 SeenZero = (2, None)
    compute 1 _        = (0, SeenOne)
    compute 2 SeenZero = (3, None)
    compute 2 _        = (2, None)
    compute _ SeenZero = (1, None)
    compute _ _        = (0, None)

    val '0' '0' = 0
    val '1' '1' = 1
    val _ _ = 2

-- Template
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

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

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[_n] <- getInts 1
    ~[p, q] <- getNext 2
    let
      s = P.zip p q
      has tar (c1, c2) = elem tar [c1, c2]
      shouldCut :: Bool -> Bool -> (Char, Char) -> Bool
      shouldCut False _ _ = False
      shouldCut True False c = has '0' c
      shouldCut True True _ = True
      mex :: Bool -> Bool -> Int
      mex False _ = 0
      mex True False = 1
      mex True True = 2
      optCut = let
        go acc has0 has1 [] = acc + mex has0 has1
        go acc has0 has1 (c : cs) = if  shouldCut has0 has1 c
          then  go (acc + mex has0 has1) False False (c : cs)
          else  let
          (c1, c2) = c
          in  go acc
              (has0 || c1 == '0' || c2 == '0')
              (has1 || c1 == '1' || c2 == '1')
              cs
        in  go 0 False False
    pure $ putInts [optCut s]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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


q s(k:w)=sum$zipWith(*)[1..]$(map(\c->w!!(fromEnum c - fromEnum 'a'))s)++replicate k(maximum w)
z(s:l)=q s(map read l)
main=interact$show.z.words

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  xs <- map(\c->fromEnum c - 97).filter(\c->'a'<=c&&c<='z') <$> getLine
  k <- readLn
  arr <- listArray(0,25).map read.words <$> getLine
  print $ solve xs k arr

solve :: [Int] -> Int -> UArray Int Int -> Int
solve xs k arr =sum $ zipWith (\x i->unsafeAt arr x * i) xs [1..len] ++ map (wmax*) [len+1..len+k]
   where
     !len = length xs
     !wmax = maximum [unsafeAt arr i|i<-[0..25]]

import Data.Maybe
import Data.List
import Data.Function
import qualified Data.IntSet as IS
import Text.Printf (printf)
import Control.Monad

solve :: String -> Int -> [Int] -> Int
solve s k ws = f (s ++ replicate k c)
  where
    f s    = sum $ map (\(c, i) -> fromJust (lookup c alist) * i) (zip s [1..])
    alist  = zip ['a'..'z'] ws
    (c, w) = maximumBy (compare `on` snd) $ alist

main :: IO ()
main = do
  s <- getLine
  k <- readLn
  ws <- fmap (map read . words) getLine
  print $ solve s k ws

import Data.Char

main = interact $ show . sum . zipWith (*) [1..] . solve . words

solve par = (map (xs!!) $ map (subtract (ord 'a')) (map ord str) ) ++ (replicate k $ maximum xs)
    where str = head par
          k   = read $ par !! 1
          xs  = map read (drop 2 par)

import Data.Char

main = interact $ show . sum . zipWith (*) [1..] . sol . words

sol (s:k:xsp) = (map (\x -> xs !! (ord x - ord 'a')) s) ++ (replicate (read k) $ maximum xs)
    where xs = map read xsp

import Data.Char

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

solve :: [String] -> Int
solve (s:sk:sw) = let k = read sk
                      w = map read sw
                      i = snd . maximum $ zip w [0..]
                      c = chr (i + (ord 'a'))
                      f = s ++ (concat [[c] | r <- [1..k]])
                  in  solve' f 1 w
                  where
                      solve' :: String -> Int -> [Int] -> Int
                      solve' []     _ _ = 0
                      solve' (f:fs) i w = (w !! ((ord f) - (ord 'a'))) * i + (solve' fs (i + 1) w)

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

solve s k ws = sum $ zipWith (*) [1..] $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

dot [] _ = 0
dot _ [] = 0
dot (x:xs) (y:ys) = dot xs ys + x*y

calValue xs = dot xs [1..]

solve s k ws = calValue $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

init_val n [] mp  = 0
init_val n (c:str) mp =
  n * k + (init_val (n + 1) str mp)
  where k = fromJust $ Map.lookup c mp

main = do
  str <- getstr
  k <- getint
  values <- getints
  let mp = Map.fromList $ zip ['a'..'z'] values
      init = init_val 1 str mp
      len = length str
      mx = maximum values
      res = init + (sum $ map (* mx) [len + 1..len + k])
  putStrLn (show res)

import Control.Applicative
import Data.Char
import Data.List
import Data.Array

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  w ++ (replicate k m)

import Data.Char (ord)
main :: IO ()
main = getLine >>= \s -> readLn >>= \k -> getContents >>= print . solve s k . map read . words

solve :: String -> Int -> [Int] -> Int
solve s k ws = sum $ zipWith (*) [1..length s + k] (map ((ws!!) . subtract (ord 'a') . ord) s ++ repeat (maximum ws))

import Data.Char
main=getLine>>= \s->getContents>>=print.f s.map read.words
f s (k:x)=sum$zipWith(*)[1..length s+k](map((x!!).subtract(ord 'a').ord)s++repeat(maximum x))

import Data.Char (ord)

main :: IO ()
main = getLine >>= \s -> readLn >>= \k -> getContents >>= print . solve s k . map read . words

solve :: String -> Int -> [Int] -> Int
solve s k ws = sum $ zipWith (*) [1..] (map (\c -> ws !! (ord c - ord 'a')) s ++ replicate k (maximum ws))

main = do
  s <- getLine
  k <- readLn
  ws <- map read . words <$> getLine
  let (_,best) = maximum (zip ws ['a'..])
  print $ sum $ zipWith (*) [1..] $
          map ((ws !!) . (subtract (fromEnum 'a') . fromEnum)) $
          s ++ replicate k best

readInt x = read x :: Int
main = interact $ show . solve' . words
solve' (s:k:ws) = solve s (readInt k) (map readInt ws)

solve s k ws = zipWith (*) [1..] $ (map (\c -> ws !! (ord c)) s) ++ replicate k (maximum ws)
	where ord c = fromEnum c - 97

import Control.Applicative
import Data.Char
import Data.List
import Data.Array

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  sort $ init w ++ (replicate k m) ++ [last w]

import Control.Applicative
import Data.Char
import Data.List
import Data.Array

main = do
    s <- map ((subtract 97).ord) <$> getLine
    k <- readLn :: IO Int
    ws <- map (read :: String -> Int).words <$> getLine
    let as = array (0,25) $ zip [0..] ws
        m = maximum ws
        w = map (as!) s
    print $ sum $ zipWith (*) [1..] $  sort $ w ++ (replicate k m)


import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[_, k] <- readInts
    xs <- readInts
    let xs' = reverse $ sort xs
        (as, xs'') = splitAt k xs'
        (bs, xs''') = splitAt k xs''
    print $ sum (map fromEnum $ zipWith (==) as bs) + sum xs'''

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

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

-- https://codeforces.com/contest/1618/problem/D
import Control.Monad (replicateM)
import Data.List (sort)

answer :: Int -> Int -> [Int] -> Int
answer n k l = sum (zipWith div numerators denominators) + sum remain where
    denominators = take k l
    numerators = take k $ drop k l
    remain = drop (2*k) l

main = getLine >>= flip replicateM run . read
run = do
    [n, k] <- (read <$>) . words <$> getLine
    numbers <- reverse . sort . (read <$>) . words <$> getLine
    print $ answer n k numbers