The Free Meteor Association (FMA) has got a problem: as meteors are moving, the Universal Cosmic Descriptive Humorous Program (UCDHP) needs to add a special module that would analyze this movement. UCDHP stores some secret information about meteors as an n × m table with integers in its cells. The order of meteors in the Universe is changing. That's why the main UCDHP module receives the following queries:  The query to swap two table rows;  The query to swap two table columns;  The query to obtain a secret number in a particular table cell. As the main UCDHP module is critical, writing the functional of working with the table has been commissioned to you.

The first line contains three space-separated integers n, m and k (1 ≤ n, m ≤ 1000, 1 ≤ k ≤ 500000) — the number of table columns and rows and the number of queries, correspondingly. Next n lines contain m space-separated numbers each — the initial state of the table. Each number p in the table is an integer and satisfies the inequality 0 ≤ p ≤ 106. Next k lines contain queries in the format "si xi yi", where si is one of the characters "с", "r" or "g", and xi, yi are two integers.   If si = "c", then the current query is the query to swap columns with indexes xi and yi (1 ≤ x, y ≤ m, x ≠ y);  If si = "r", then the current query is the query to swap rows with indexes xi and yi (1 ≤ x, y ≤ n, x ≠ y);  If si = "g", then the current query is the query to obtain the number that located in the xi-th row and in the yi-th column (1 ≤ x ≤ n, 1 ≤ y ≤ m).  The table rows are considered to be indexed from top to bottom from 1 to n, and the table columns — from left to right from 1 to m.

For each query to obtain a number (si = "g") print the required number. Print the answers to the queries in the order of the queries in the input.

NoteLet's see how the table changes in the second test case.After the first operation is fulfilled, the table looks like that:2 1 41 3 5After the second operation is fulfilled, the table looks like that:1 3 52 1 4So the answer to the third query (the number located in the first row and in the third column) will be 5.

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


You have a description of a lever as string s. We'll represent the string length as record |s|, then the lever looks as a horizontal bar with weights of length |s| - 1 with exactly one pivot. We will assume that the bar is a segment on the Ox axis between points 0 and |s| - 1.The decoding of the lever description is given below.  If the i-th character of the string equals "^", that means that at coordinate i there is the pivot under the bar.  If the i-th character of the string equals "=", that means that at coordinate i there is nothing lying on the bar.  If the i-th character of the string equals digit c (1-9), that means that at coordinate i there is a weight of mass c on the bar. Your task is, given the lever description, print if it will be in balance or not. Assume that the bar doesn't weight anything. Assume that the bar initially is in balance then all weights are simultaneously put on it. After that the bar either tilts to the left, or tilts to the right, or is in balance.

The first line contains the lever description as a non-empty string s (3 ≤ |s| ≤ 106), consisting of digits (1-9) and characters "^" and "=". It is guaranteed that the line contains exactly one character "^". It is guaranteed that the pivot of the lever isn't located in any end of the lever bar. To solve the problem you may need 64-bit integer numbers. Please, do not forget to use them in your programs.

Print "left" if the given lever tilts to the left, "right" if it tilts to the right and "balance", if it is in balance.

NoteAs you solve the problem, you may find the following link useful to better understand how a lever functions: http://en.wikipedia.org/wiki/Lever.The pictures to the examples:

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)

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

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

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


A positive integer $$$x$$$ is called a power of two if it can be represented as $$$x = 2^y$$$, where $$$y$$$ is a non-negative integer. So, the powers of two are $$$1, 2, 4, 8, 16, \dots$$$.You are given two positive integers $$$n$$$ and $$$k$$$. Your task is to represent $$$n$$$ as the sum of exactly $$$k$$$ powers of two.

The only line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10^9$$$, $$$1 \le k \le 2 \cdot 10^5$$$).

If it is impossible to represent $$$n$$$ as the sum of $$$k$$$ powers of two, print NO. Otherwise, print YES, and then print $$$k$$$ positive integers $$$b_1, b_2, \dots, b_k$$$ such that each of $$$b_i$$$ is a power of two, and $$$\sum \limits_{i = 1}^{k} b_i = n$$$. If there are multiple answers, you may print any of them.

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"

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


You have $$$n$$$ rectangular wooden blocks, which are numbered from $$$1$$$ to $$$n$$$. The $$$i$$$-th block is $$$1$$$ unit high and $$$\lceil \frac{i}{2} \rceil$$$ units long.Here, $$$\lceil \frac{x}{2} \rceil$$$ denotes the result of division of $$$x$$$ by $$$2$$$, rounded up. For example, $$$\lceil \frac{4}{2} \rceil = 2$$$ and $$$\lceil \frac{5}{2} \rceil = \lceil 2.5 \rceil = 3$$$.For example, if $$$n=5$$$, then the blocks have the following sizes: $$$1 \times 1$$$, $$$1 \times 1$$$, $$$1 \times 2$$$, $$$1 \times 2$$$, $$$1 \times 3$$$.  The available blocks for $$$n=5$$$ Find the maximum possible side length of a square you can create using these blocks, without rotating any of them. Note that you don't have to use all of the blocks.  One of the ways to create $$$3 \times 3$$$ square using blocks $$$1$$$ through $$$5$$$

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^9$$$) — the number of blocks.

For each test case, print one integer — the maximum possible side length of a square you can create.

NoteIn the first test case, you can create a $$$1 \times 1$$$ square using only one of the blocks.In the second test case, one of the possible ways to create a $$$3 \times 3$$$ square is shown in the statement. It is impossible to create a $$$4 \times 4$$$ or larger square, so the answer is $$$3$$$.

import Data.Ratio

main :: IO ()
main = interact solve

solve :: String -> String
solve = output . map msl . input

input :: String -> [Integer]
input = map read . tail . lines

output :: [Integer] -> String
output = unlines . map show

msl :: Integer -> Integer
msl = ceiling . (% 2)


You are given a special jigsaw puzzle consisting of $$$n\cdot m$$$ identical pieces. Every piece has three tabs and one blank, as pictured below.  The jigsaw puzzle is considered solved if the following conditions hold:  The pieces are arranged into a grid with $$$n$$$ rows and $$$m$$$ columns.  For any two pieces that share an edge in the grid, a tab of one piece fits perfectly into a blank of the other piece. Through rotation and translation of the pieces, determine if it is possible to solve the jigsaw puzzle.

The test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. Each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n,m \le 10^5$$$).

For each test case output a single line containing "YES" if it is possible to solve the jigsaw puzzle, or "NO" otherwise. You can print each letter in any case (upper or lower).

NoteFor the first test case, this is an example solution:   For the second test case, we can show that no solution exists.For the third test case, this is an example solution:

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 = "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.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


Once Bob needed to find the second order statistics of a sequence of integer numbers. Lets choose each number from the sequence exactly once and sort them. The value on the second position is the second order statistics of the given sequence. In other words it is the smallest element strictly greater than the minimum. Help Bob solve this problem.

The first input line contains integer n (1 ≤ n ≤ 100) — amount of numbers in the sequence. The second line contains n space-separated integer numbers — elements of the sequence. These numbers don't exceed 100 in absolute value.

If the given sequence has the second order statistics, output this order statistics, otherwise output NO.

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

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

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


The heat during the last few days has been really intense. Scientists from all over the Berland study how the temperatures and weather change, and they claim that this summer is abnormally hot. But any scientific claim sounds a lot more reasonable if there are some numbers involved, so they have decided to actually calculate some value which would represent how high the temperatures are.Mathematicians of Berland State University came up with a special heat intensity value. This value is calculated as follows:Suppose we want to analyze the segment of $$$n$$$ consecutive days. We have measured the temperatures during these $$$n$$$ days; the temperature during $$$i$$$-th day equals $$$a_i$$$.We denote the average temperature of a segment of some consecutive days as the arithmetic mean of the temperature measures during this segment of days. So, if we want to analyze the average temperature from day $$$x$$$ to day $$$y$$$, we calculate it as $$$\frac{\sum \limits_{i = x}^{y} a_i}{y - x + 1}$$$ (note that division is performed without any rounding). The heat intensity value is the maximum of average temperatures over all segments of not less than $$$k$$$ consecutive days. For example, if analyzing the measures $$$[3, 4, 1, 2]$$$ and $$$k = 3$$$, we are interested in segments $$$[3, 4, 1]$$$, $$$[4, 1, 2]$$$ and $$$[3, 4, 1, 2]$$$ (we want to find the maximum value of average temperature over these segments).You have been hired by Berland State University to write a program that would compute the heat intensity value of a given period of days. Are you up to this task?

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 5000$$$) — the number of days in the given period, and the minimum number of days in a segment we consider when calculating heat intensity value, respectively. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le 5000$$$) — the temperature measures during given $$$n$$$ days.

Print one real number — the heat intensity value, i. e., the maximum of average temperatures over all segments of not less than $$$k$$$ consecutive days. Your answer will be considered correct if the following condition holds: $$$|res - res_0| < 10^{-6}$$$, where $$$res$$$ is your answer, and $$$res_0$$$ is the answer given by the jury's solution.

-- Codeforces 1003C
import Data.List

sumList :: [Int] -> Int -> Int
sumList list deplacement = maximum newList
    where numList = [0..deplacement - 1]
          zeroList = replicate ((length list) - deplacement + 1) 0
          listList = map (\x -> drop x list) numList
          newList = foldl' (zipWith (+)) zeroList listList

fun :: ([Int], [Int]) -> [Int] -> ([Int], [Int])
fun (xs, list) shorter = (xs ++ [maxVal], zippedList)
    where zippedList = zipWith (+) list shorter
          maxVal = maximum zippedList

zipList :: [Int] -> [Int]
zipList list = fst newList
    where numList = [0..length list - 1]
          zeroList = replicate (length list) 0
          listList = map (\x -> drop x list) numList :: [[Int]]
          newList = foldl fun ([], zeroList) listList

createFold :: [Int] -> [Int]
createFold list = fst (foldl' fun ([], []) list)
    where fun :: ([Int], [Int]) -> Int -> ([Int], [Int])
          fun ([], []) i = ([i], [i])
          fun (maxlist, headList) i = (newMaxList, newHeadList)
            where newHeadList = i : map (+i) headList
                  newMaxList = zipWith max (maxlist ++ [0]) newHeadList

foldFold :: [Int] -> Int -> Double
foldFold list minLength = snd (foldl f (1, 0) list)
    where   f :: (Int, Double) -> Int -> (Int, Double)
            f (i, s) x
                | i < minLength = (i + 1, s)
                | otherwise = (i + 1, max s average)
                where average = (fromIntegral x) / (fromIntegral i)

foldAverage :: [Int] -> Int -> Double
foldAverage list minLength = foldFold (zipList list) minLength

main :: IO ()
main = do
    input <- getLine
    number <- getLine
    let minLength = (map (read :: String -> Int) (words input)) !! 1
    let numbers = map (read :: String -> Int) (words number)
    -- let result = findAnswer maxSumQueue numbers minLength
    let result = foldAverage numbers minLength
    print result

-- Codeforces 1003C
import Data.List

maxSumQueue' :: [Int] -> Int -> Int -> Int
maxSumQueue' list minLength accu
    | length list < minLength = accu
    | otherwise = maxSumQueue' rest minLength newAccu
        where newAccu = maximum [accu, sum (take minLength list)]
              rest = drop 1 list
maxSumQueue :: [Int] -> Int -> Int
maxSumQueue list minLength = maxSumQueue' list minLength 0
maxAverage :: [Int] -> Int -> Double
maxAverage list minLength = fromIntegral maxSum / fromIntegral minLength
    where maxSum = maxSumQueue list minLength

createFold :: [Int] -> [Int]
createFold list = fst (foldl' fun ([], []) list)
    where fun :: ([Int], [Int]) -> Int -> ([Int], [Int])
          fun ([], []) i = ([i], [i])
          fun (maxlist, headList) i = (newMaxList, newHeadList)
            where newHeadList = i : map (+i) headList
                  newMaxList = zipWith max (maxlist ++ [0]) newHeadList
foldFold :: [Int] -> Int -> Double
foldFold list minLength = snd (foldl f (1, 0) list)
    where   f :: (Int, Double) -> Int -> (Int, Double)
            f (i, s) x
                | i < minLength = (i + 1, s)
                | otherwise = (i + 1, max s average)
                where average = (fromIntegral x) / (fromIntegral i)

foldAverage :: [Int] -> Int -> Double
foldAverage list minLength = foldFold (createFold list) minLength

main :: IO ()
main = do
    input <- getLine
    number <- getLine
    let minLength = (map (read :: String -> Int) (words input)) !! 1
    let numbers = map (read :: String -> Int) (words number)
    -- let result = findAnswer maxSumQueue numbers minLength
    let result = maxAverage numbers minLength
    print result


There is a country with $$$n$$$ citizens. The $$$i$$$-th of them initially has $$$a_{i}$$$ money. The government strictly controls the wealth of its citizens. Whenever a citizen makes a purchase or earns some money, they must send a receipt to the social services mentioning the amount of money they currently have.Sometimes the government makes payouts to the poor: all citizens who have strictly less money than $$$x$$$ are paid accordingly so that after the payout they have exactly $$$x$$$ money. In this case the citizens don't send a receipt.You know the initial wealth of every citizen and the log of all events: receipts and payouts. Restore the amount of money each citizen has after all events.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^{5}$$$) — the numer of citizens. The next line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$0 \le a_{i} \le 10^{9}$$$) — the initial balances of citizens. The next line contains a single integer $$$q$$$ ($$$1 \le q \le 2 \cdot 10^{5}$$$) — the number of events. Each of the next $$$q$$$ lines contains a single event. The events are given in chronological order. Each event is described as either 1 p x ($$$1 \le p \le n$$$, $$$0 \le x \le 10^{9}$$$), or 2 x ($$$0 \le x \le 10^{9}$$$). In the first case we have a receipt that the balance of the $$$p$$$-th person becomes equal to $$$x$$$. In the second case we have a payoff with parameter $$$x$$$.

Print $$$n$$$ integers — the balances of all citizens after all events.

NoteIn the first example the balances change as follows: 1 2 3 4 $$$\rightarrow$$$ 3 3 3 4 $$$\rightarrow$$$ 3 2 3 4 $$$\rightarrow$$$ 3 2 3 4In the second example the balances change as follows: 3 50 2 1 10 $$$\rightarrow$$$ 3 0 2 1 10 $$$\rightarrow$$$ 8 8 8 8 10 $$$\rightarrow$$$ 8 8 20 8 10

{-# LANGUAGE LambdaCase #-}
import Control.Applicative
import Control.Monad
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.ByteString.Char8 as B
import Control.Monad.ST
readI b = i where Just (i,_) = B.readInt b

main = do
  n <- readI <$> B.getLine
  as0 <- listArray (1,n) . map readI . B.words <$> B.getLine
  q <- readI <$> B.getLine
  ops <- replicateM q (map readI . B.words <$> B.getLine)
  let as' = runSTArray $ do
        t <- newArray (1,n) False :: ST s (STUArray s Int Bool)
        as <- newArray (1,n) Nothing
        l <- newSTRef Nothing
        forM_ (reverse ops) $ \case
          [1,p,x] -> do
            next <- readArray as p
            lvl <- readSTRef l
            let cur | Just l <- lvl, l > x = Just l
                    | otherwise = Just x
            writeArray t p True
            writeArray as p (next <|> cur)
          [2,x] -> modifySTRef' l $ Just . maybe x (max x)
        lmax <- readSTRef l
        forM_ [1..n] $ \i -> do
          t' <- readArray t i
          if t' then writeArray as i . flip (<|>) lmax =<< readArray as i
            else writeArray as i $ Just $ maybe (as0 ! i) (max (as0 ! i)) lmax
        return as
  putStrLn $ unwords $ map (maybe undefined show) $ elems as'


Little penguin Polo has an n × m matrix, consisting of integers. Let's index the matrix rows from 1 to n from top to bottom and let's index the columns from 1 to m from left to right. Let's represent the matrix element on the intersection of row i and column j as aij.In one move the penguin can add or subtract number d from some matrix element. Find the minimum number of moves needed to make all matrix elements equal. If the described plan is impossible to carry out, say so.

The first line contains three integers n, m and d (1 ≤ n, m ≤ 100, 1 ≤ d ≤ 104) — the matrix sizes and the d parameter. Next n lines contain the matrix: the j-th integer in the i-th row is the matrix element aij (1 ≤ aij ≤ 104).

In a single line print a single integer — the minimum number of moves the penguin needs to make all matrix elements equal. If that is impossible, print "-1" (without the quotes).

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

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


Bizon the Champion isn't just attentive, he also is very hardworking.Bizon the Champion decided to paint his old fence his favorite color, orange. The fence is represented as n vertical planks, put in a row. Adjacent planks have no gap between them. The planks are numbered from the left to the right starting from one, the i-th plank has the width of 1 meter and the height of ai meters.Bizon the Champion bought a brush in the shop, the brush's width is 1 meter. He can make vertical and horizontal strokes with the brush. During a stroke the brush's full surface must touch the fence at all the time (see the samples for the better understanding). What minimum number of strokes should Bizon the Champion do to fully paint the fence? Note that you are allowed to paint the same area of the fence multiple times.

The first line contains integer n (1 ≤ n ≤ 5000) — the number of fence planks. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109).

Print a single integer — the minimum number of strokes needed to paint the whole fence.

NoteIn the first sample you need to paint the fence in three strokes with the brush: the first stroke goes on height 1 horizontally along all the planks. The second stroke goes on height 2 horizontally and paints the first and second planks and the third stroke (it can be horizontal and vertical) finishes painting the fourth plank.In the second sample you can paint the fence with two strokes, either two horizontal or two vertical strokes.In the third sample there is only one plank that can be painted using a single vertical stroke.

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

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

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

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


There are n cows playing poker at a table. For the current betting phase, each player's status is either "ALLIN", "IN", or "FOLDED", and does not change throughout the phase. To increase the suspense, a player whose current status is not "FOLDED" may show his/her hand to the table. However, so as not to affect any betting decisions, he/she may only do so if all other players have a status of either "ALLIN" or "FOLDED". The player's own status may be either "ALLIN" or "IN".Find the number of cows that can currently show their hands without affecting any betting decisions.

The first line contains a single integer, n (2 ≤ n ≤ 2·105). The second line contains n characters, each either "A", "I", or "F". The i-th character is "A" if the i-th player's status is "ALLIN", "I" if the i-th player's status is "IN", or "F" if the i-th player's status is "FOLDED".

The first line should contain a single integer denoting the number of players that can currently show their hands.

NoteIn the first sample, cows 1, 4, 5, and 6 can show their hands. In the second sample, only cow 3 can show her hand.

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) коровки

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


Petya loves football very much, especially when his parents aren't home. Each morning he comes to the yard, gathers his friends and they play all day. From time to time they have a break to have some food or do some chores (for example, water the flowers).The key in football is to divide into teams fairly before the game begins. There are n boys playing football in the yard (including Petya), each boy's football playing skill is expressed with a non-negative characteristic ai (the larger it is, the better the boy plays). Let's denote the number of players in the first team as x, the number of players in the second team as y, the individual numbers of boys who play for the first team as pi and the individual numbers of boys who play for the second team as qi. Division n boys into two teams is considered fair if three conditions are fulfilled:  Each boy plays for exactly one team (x + y = n).  The sizes of teams differ in no more than one (|x - y| ≤ 1).  The total football playing skills for two teams differ in no more than by the value of skill the best player in the yard has. More formally: Your task is to help guys divide into two teams fairly. It is guaranteed that a fair division into two teams always exists.

The first line contains the only integer n (2 ≤ n ≤ 105) which represents the number of guys in the yard. The next line contains n positive space-separated integers, ai (1 ≤ ai ≤ 104), the i-th number represents the i-th boy's playing skills.

On the first line print an integer x — the number of boys playing for the first team. On the second line print x integers — the individual numbers of boys playing for the first team. On the third line print an integer y — the number of boys playing for the second team, on the fourth line print y integers — the individual numbers of boys playing for the second team. Don't forget that you should fulfil all three conditions: x + y = n, |x - y| ≤ 1, and the condition that limits the total skills. If there are multiple ways to solve the problem, print any of them. The boys are numbered starting from one in the order in which their skills are given in the input data. You are allowed to print individual numbers of boys who belong to the same team in any order.

NoteLet's consider the first sample test. There we send the first and the second boy to the first team and the third boy to the second team. Let's check all three conditions of a fair division. The first limitation is fulfilled (all boys play), the second limitation on the sizes of groups (|2 - 1| = 1 ≤ 1) is fulfilled, the third limitation on the difference in skills ((2 + 1) - (1) = 2 ≤ 2) is fulfilled.

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