{-# LANGUAGE BangPatterns #-}
import Data.List (transpose)
import Data.Bits ((.&.), xor)
import Data.Word (Word8)
import Data.Maybe (fromJust)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Control.Monad (sequence, replicateM)

solve :: [[Word8]] -> [[Word8]] -> [Word8]
solve a q = val `seq` foldr loop (`seq` []) (map head q) (val, 0)
    where
    !val = foldl' xor 0 . concat $ zipWith (zipWith (.&.)) a (transpose a)

    loop x f (i, j)
        | x == 3 = i' `seq` i':f (i', 0)
        | otherwise = j' `seq` f (i, j `xor` 1)
        where
        !i' = i `xor` j
        !j' = j `xor` 1

parse :: Num a => ByteString -> [a]
parse line = fromIntegral . fst . fromJust . C.readInt <$> C.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap parse <$> replicateM n B.getLine
    [m] <- parse <$> B.getLine
    q <- fmap parse <$> replicateM m B.getLine
    mapM_ (putStr . show) $ solve a q

{-# LANGUAGE BangPatterns #-}
import Data.Bits (xor)
import Data.Word (Word8)
import Data.Maybe (fromJust)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Control.Monad (sequence, replicateM)

solve :: [[Word8]] -> [[Word8]] -> [Word8]
solve a q = val `seq` foldr loop (`seq` []) (map head q) (val, 0)
    where
    !val = foldl' xor 0 $ zipWith (!!) a [0..]

    loop x f (i, j)
        | x == 3 = i' `seq` i':f (i', 0)
        | otherwise = j' `seq` f (i, j `xor` 1)
        where
        !i' = i `xor` j
        !j' = j `xor` 1

parse :: Num a => ByteString -> [a]
parse line = fromIntegral . fst . fromJust . C.readInt <$> C.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap parse <$> replicateM n B.getLine
    [m] <- parse <$> B.getLine
    q <- fmap parse <$> replicateM m B.getLine
    mapM_ (putStr . show) $ solve a q

{-# LANGUAGE BangPatterns #-}

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

import Control.Exception

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

main = catch main_ (\err ->print (err :: SomeException))

main_ = do
  n <- readLn
  diag <- forM [0..n-1] $ \i -> do
    b <- ('1'==).flip B.index (2*i) <$> B.getLine
    return $! b
  _ <- getLine
  qs <- map readInt.B.words <$> B.getContents
  putStrLn . map (bool '1' '0') $ solve (foldl' (/=) False diag) qs

solve :: Bool -> [Int] -> [Bool]
solve !res (3:qs) = res : solve res qs
solve !res (_:_:qs) = solve (res /= True) qs
solve _ _ = []

{-# LANGUAGE BangPatterns #-}
import Data.Bits (xor)
import Data.Word (Word8)
import Data.Maybe (fromJust)
import Data.Foldable (foldl')
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Control.Monad (sequence, replicateM)

solve :: [[Word8]] -> [[Word8]] -> [Word8]
solve a q = val `seq` foldr loop (`seq` []) (map head q) (val, 0)
    where
    !val = foldl' xor 0 . map head $ zipWith drop [0..] a

    loop x f (i, j)
        | x == 3 = i' `seq` i':f (i', 0)
        | otherwise = j' `seq` f (i, j `xor` 1)
        where
        !i' = i `xor` j
        !j' = j `xor` 1

parse :: Num a => ByteString -> [a]
parse line = fromIntegral . fst . fromJust . C.readInt <$> C.words line

main = do
    [n] <- parse <$> B.getLine
    a <- fmap parse <$> replicateM n B.getLine
    [m] <- parse <$> B.getLine
    q <- fmap parse <$> replicateM m B.getLine
    mapM_ (putStr . show) $ solve a q

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

import Control.Monad (replicateM,forM_,forM,foldM_)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (foldl')
import System.IO (hFlush,stdout)
import Data.Char (isDigit,isSpace)

readDiagonal :: Int -> IO [Bool]
readDiagonal n = do
  forM [0..n-1] $ \i -> do
    line <- BS.getLine
    let ws = BS.words line
    return $ (ws !! i) == "1"

readDiagonal' :: Int -> IO [Bool]
readDiagonal' n = do
  forM [0..n-1] $ \i -> do
    line <- BS.getLine
    let ind = BS.findIndices isDigit line
    let ch = BS.index line (ind !! i)
    return $ ch == '1'

nthWord :: Int -> ByteString -> Maybe Int
nthWord n bs = skip 0 >>= go n
  where
    len = BS.length bs
    skip :: Int -> Maybe Int -- skip spaces
    skip k = if isSpace (BS.index bs k)
               then if k+1 < len then skip (k+1) else Nothing
               else Just k
    skip' :: Int -> Maybe Int -- skip non-spaces
    skip' k = if not (isSpace (BS.index bs k))
                then if k+1 < len then skip (k+1) else Nothing
                else Just k
    go 0  !k = Just k
    go !n !k = skip' k >>= go (n-1)

readDiagonal'' :: Int -> IO [Bool]
readDiagonal'' n = do
  forM [0..n-1] $ \i -> do
    line <- BS.getLine
    let Just ind = nthWord i line
    let ch = BS.index line ind
    return $ ch == '1'

xor :: Bool -> Bool -> Bool
xor True False = True
xor False True = True
xor _ _        = False

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  diag <- readDiagonal'' n
  let sq = foldl' xor False diag

  q <- getLine --> read :: IO Int

  let doit !sq' i = do
        if i `mod` 1000 == 0
          then hFlush stdout
          else return ()
        line <- BS.getLine
        if BS.null line
          then return sq'
          else case BS.head line of
                '1' -> return $ not sq'
                '2' -> return $ not sq'
                '3' -> do putChar $ if sq' then '1' else '0'
                          return sq'
                _   -> return sq'
  foldM_ doit sq [1..q]
  BS.putStrLn ""

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

import Control.Exception

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

main = catch main_ (\err ->print (err :: SomeException))

main_ = do
  n <- readLn
  diag <- forM [0..n-1] $ \i -> do
    b <- ('1'==).flip B.index (2*i) <$> B.getLine
    return $! b
  _ <- getLine
  qs <- map readInt.B.words <$> B.getContents
  putStrLn . map (bool '1' '0') $ solve (foldl' (/=) False diag) qs

solve :: Bool -> [Int] -> [Bool]
solve res (3:qs) = res : solve res qs
solve res (_:_:qs) = solve (res /= True) qs
solve _ _ = []


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

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

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

solve = do
  [n, _] <- map read . words <$> getLine
  a <- replicateM 3 getLine

  bs :: IOUArray (Int, Int) Bool <- newArray ((1, 1), (3, n)) False

  let
    aa :: UArray (Int, Int) Char = listArray ((1, 1), (3, n)) $ concat a

    dfs (i, j)
      | j >= n = return True
      | otherwise = do
      b <- readArray bs (i, j)
      if not b
        then do
          writeArray bs (i, j) True

          if j > n || aa!(i, j+1) /= '.'
            then return False
            else
              or <$> (forM [max (i-1) 1..min (i+1) 3] $ \i ->
                if all (== '.') [aa!(i, j) | j <- [j+1..j+3], j <= n]
                  then dfs (i, j+3)
                  else return False)

        else
          return False

  let si = (fromJust $ elemIndex 's' $ map (!!0) a) + 1
  r <- dfs (si, 1)

  putStrLn $ if r then "YES" else "NO"

main = do
  t <- readLn
  replicateM t solve

import qualified Data.List as L
answer::[Int] -> Int -> [String] -> Int -> Bool
answer [] j ds n = False
answer is j d@(d0:d1:d2:ds) n | j<n = answer (L.nub [nexti|i<- is,nexti<-[i-1,i,i+1],isok0 i j nexti d]) (j+3) ds n
                              | otherwise = True
answer is j ds n = (null [nexti|i<- is,nexti<-[i-1,i,i+1],isok0 i j nexti ds]) == False

isok0::Int -> Int -> Int -> [String] -> Bool
isok0 i j nexti [] = True
isok0 i j nexti (d0:d1:d2:ds) = 0 <= nexti && nexti < 3 && (d0 !! i)=='.' && (d0 !! nexti) == '.' && (d1 !! nexti) == '.' && (d2 !! nexti) == '.'
isok0 i j nexti (d0:d1:ds) = 0 <= nexti && nexti < 3 && (d0 !! i)=='.' && (d0 !! nexti) == '.' && (d1 !! nexti) == '.'
isok0 i j nexti (d0:ds) = 0 <= nexti && nexti < 3 && (d0 !! i)=='.' && (d0 !! nexti) == '.'
trans [[],[],[]] = []
trans a = (map head a):(trans (map tail a))
readInput 0 = return []
readInput n = do
  w0 <- getLine
  next <- readInput (n-1)
  return (w0:next)
execTest 0 = return ()
execTest t = do
  w0 <- getLine
  let [n,k] = [read n::Int|n<-(words w0)]
  d <- readInput 3
  let dt = trans d
  let h = head dt
  let Just i = L.elemIndex 's' h
  let res=answer [i] 0 (tail dt) n
  putStrLn $ if res then "YES" else "NO"
  execTest (t-1)
main=do
  w0 <- getLine
  let t = read w0::Int
  execTest t


import Control.Monad
import Control.Applicative

main = do
  [_, h, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve h k as

solve :: Integer -> Integer -> [Integer] -> Integer
solve h k [a0] = (a0 + k - 1) `div` k
solve h k (a0:(a1:as)) =
    if a0 `mod` k + a1 <= h
    then (a0 + a1) `div` k + solve h k (((a0 + a1) `mod` k):as)
    else (a0 + k - 1) `div` k + solve h k (a1:as)

import Control.Applicative( (<$>))
main = do
    tokens <- return . words =<< getContents
    let n:capacity:lengthPerSec:hights = read <$> tokens
	sendfull buf [] = (buf,[])
	sendfull buf (p:ps) = if buf+p <= capacity
				then sendfull (buf+p) ps
				else (buf,p:ps)
	smash buf = buf `divMod` lengthPerSec
	process::(Int,[Int]) -> Integer -> Integer
	process (0,[]) sec = sec
	process (buf,potatoes) sec = process (sendfull potatoRest potatoes) (sec+toInteger timeplus)
	    where
		(times, pmod) = smash buf
		judge = times == 0 && pmod /= 0
		timeplus = if judge then 1 else times
		potatoRest = if judge then 0 else pmod
    print $ process (0,take n hights) 0

import Data.Functor

main :: IO()
main = do
    let readInts = map read . words
    [n, h, k] <- readInts <$> getLine
    a <- readInts <$> getLine
    print $ solve h k a 0

solve :: Integer -> Integer -> [Integer] -> Integer -> Integer
solve _ k []    m = (m + k - 1) `div` k
solve h k (a:s) m | m + a <= h = solve h k s (m + a)
                  | otherwise = let x = (a + m - h + k - 1) `div` k
                                in x + solve h k (a:s) (max 0 (m - k * x))

import Control.Monad
import Control.Applicative

main = do
  [_, h, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve h k as

solve :: Int -> Int -> [Int] -> Int
solve h k [a0] = (a0 + k - 1) `div` k
solve h k (a0:(a1:as)) =
    if a0 `mod` k + a1 <= h
    then (a0 + a1) `div` k +  solve h k (((a0 + a1) `mod` k):as)
    else (a0 + k - 1) `div` k + solve h k (a1:as)

import Control.Applicative( (<$>))
main = do
    tokens <- return . words =<< getContents
    let n:capacity:lengthPerSec:hights = read <$> tokens
	sendfull buf [] = (buf,[])
	sendfull buf (p:ps) = if buf+p <= capacity
				then sendfull (buf+p) ps
				else (buf,p:ps)
	smash buf = buf `divMod` lengthPerSec
	process (0,[]) sec = sec
	process (buf,potatoes) sec = process (sendfull potatoRest potatoes) (sec+timeplus)
	    where
		(times, pmod) = smash buf
		judge = times == 0 && pmod /= 0
		timeplus = if judge then 1 else times
		potatoRest = if judge then 0 else pmod
    print $ process (0,take n hights) 0


import Data.List
main = interact$f.map read.words
f (a:b:xs) = (show $foldl (\acc x-> acc + div (x+1) 2) 0 list) ++ " " ++ (show $ sum list)
	where list = map length $ groupBy (\a b->b-a==1)$ [1..(a-1)] \\ (g xs)
g [] = []
g (1:a:b:xs) = [a, b] ++ (g xs)
g (2:a:xs) = a:(g xs)

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

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

readInt = 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 . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (x,k) <- readIntPair
    l <- concat . map tail <$> replicateM k readInts
    let unused = S.toList $ S.fromList [1..x-1] S.\\ S.fromList l
        maxM = length unused
        minM = go unused
        go (a:b:l) | a + 1 == b = 1 + go l
        go (a:l) = 1 + go l
        go [] = 0
    putStrLn $ unwords $ map show $ [minM,maxM]

{-# LANGUAGE BangPatterns #-}
import Data.List
main=interact$unwords.map show.f.map read.words
f(x:k:xs)=[go 0 ys, length ys]
   where
     ys = unused [1..x-1] $ sort $ parse xs
     go !res (x:y:xs)
       | x+1==y = go (res+1) xs
       | otherwise = go (res+1) (y:xs)
     go res [x] = res+1
     go res [] = res

unused (x:xs) (y:ys)
  | x == y = unused xs ys
  | x < y = x : unused xs (y:ys)
unused xs _ = xs

parse (1:x:y:xs) = x : y : parse xs
parse (2:x:xs) = x : parse xs
parse _ = []


main :: IO ()
main = do str <- getLine
          let n = read str
          putStrLn . unwords . map show $ n:[1..(n-1)]

import Data.List (intercalate)

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

main :: IO ()
main  =  do
    n  <-  readLn
    prints $ n : [1 .. (n-1)]

import Control.Applicative

main :: IO ()
main = do
  n <- read <$> getLine
  putStrLn $ unwords $ map show $ n:[1..n-1]

main = interact $ (++ "\n") . unwords . map show . (\n -> n:[1..n-1]) . read . head . lines

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Integer -> [Integer]
solve n = n : [1..n-1]

main = do
  n <- readLn
  putStrLn $ unwords $ map show $ n : [1..n-1]

import Data.List

main :: IO ()
main = do
  n <- readLn
  putStrLn $ intercalate " "
           $ map show
           $ (if n == 1 then (1 :) else ([n, 1] ++)) [2..n-1]

import qualified Data.List as L

main :: IO()
main = do
	(w:ws) <- words `fmap` getContents
	putStrLn $ L.foldl' (\s num-> s ++ (show num) ++ " ") "" $ readInt(w):[1..((readInt(w))-1)]

readInt :: String -> Int
readInt = read

calc :: Int -> [Int]
calc 1 = [1]
calc 2 = [2, 1]
calc n = [n, 1] ++ [2..n-1]

main = do s <- getLine
          putStrLn $ unwords $ map show $ calc $ read s

import Data.List

work n = intercalate " " (map show (n : [1 .. n - 1]))

main = do
	line <- getLine
	putStrLn(work (read line :: Int))

import Control.Applicative
import Data.List

main= do
 	x<-read <$> getLine
	putStrLn $ unwords $ map show (x:[1..(x-1)])

main = getLine >>= mapM_ (\x -> putStr (show x ++ " ")). (\x -> x:[1..(x-1)]). (\x -> read x :: Int) . head. words

main=(shw.slv.read=<<getLine) >> putStrLn ""
slv :: Int -> [Int]
slv n = n:[1..n-1]
shw xs=mapM_ (\c->putStr(' ':show c)) $ xs

main = interact $ (++ "\n") . unwords . map show . reverse . (\n -> [1..n]) . read . head . lines

main = do
  n <- readLn
  putStrLn $ unwords $ map show $ [n,1..n-1]

import Data.List

main :: IO ()
main = do
  n <- readLn
  putStrLn $ intercalate " "
           $ map show
           $ [2..n] ++ [1]

import Data.Array
import Data.List

f :: Int -> Array Int Int -> Array Int Int
f 1 arr = arr
f x arr = arr' // [(x, arr' ! (x - 1)), (x - 1, arr' ! x)]
  where arr' = f (x - 1) arr

(|>) :: a -> (a -> b) -> b
x |> f = f x
infixl 0 |>

main :: IO ()
main = do
  n <- readLn
  listArray (1, n) [1..n]
    |> f n
    |> elems
    |> map show
    |> intercalate " "
    |> putStrLn

import Data.List

main :: IO ()
main = do
  n <- readLn
  putStrLn $ intercalate " "
           $ map show
           $ n : 1 : [2..n-1]

import qualified Data.List as L

main :: IO()
main = do
	(w:ws) <- words `fmap` getContents
	putStrLn $ L.foldl' (\s num-> s ++ (show num) ++ " ") "" $ [2..(readInt w)] ++ [1]

readInt :: String -> Int
readInt = read

calc :: Int -> [Int]
calc n = [2..n] ++ [1]

main = do s <- getLine
          putStrLn $ unwords $ map show $ calc $ read s


import Data.Maybe
import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import qualified Data.IntMap.Strict as IM
import System.IO

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

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

main :: IO ()
main = do
  _ <- getInts
  as <- getInts
  let (result, _, _) = foldl' acc (0, 0, IM.empty) as
      acc :: (Int, Int64, IM.IntMap Int) -> Int -> (Int, Int64, IM.IntMap Int)
      acc (num, hp, mp) a
        | a >= 0 = (num + 1, hp + fromIntegral a, mp)
        | hp + fromIntegral a < 0 = (num, hp', IM.alter dec a' mp')
        | otherwise = (num + 1, hp + fromIntegral a, IM.alter inc a mp)
        where Just (a', _) = IM.lookupMin mp'
              mp' = IM.alter inc a mp
              hp' = hp + fromIntegral a - fromIntegral a'
              inc Nothing = Just 1
              inc (Just x) = Just (x + 1)
              dec Nothing = Nothing
              dec (Just 1) = Nothing
              dec (Just x) = Just (x - 1)
  hPutBuilder stdout $ intDec result `mappend` charUtf8 '\n'

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

main = do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    print $ solve S.empty 0 $ zip a [1..n]

solve :: S.Set (Int64, Int) -> Int64 -> [(Int64, Int)] -> Int
solve s h [] = S.size s
solve s h (x:xs)
    | h' >= 0 = solve s' h' xs
    | otherwise =
        let (y, s'') = S.deleteFindMin s'
         in solve s'' (h' - fst y) xs
  where
    s' = S.insert x s
    h' = h + fst x

import Data.Maybe
import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import qualified Data.IntMap.Strict as IM
import System.IO

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

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

main :: IO ()
main = do
  _ <- getInts
  as <- getInts
  let (result, _, _) = foldl' acc (0, 0, IM.empty) as
      acc :: (Int, Int64, IM.IntMap Int) -> Int -> (Int, Int64, IM.IntMap Int)
      acc (num, hp, mp) a
        | a >= 0 = (num + 1, hp + fromIntegral a, mp)
        | hp + fromIntegral a < 0 = (num, hp', IM.alter dec a' mp')
        | otherwise = (num + 1, hp + fromIntegral a, IM.alter inc a mp)
        where Just ((a', _), mp') = IM.minViewWithKey $ IM.alter inc a mp
              hp' = hp + fromIntegral a - fromIntegral a'
              inc Nothing = Just 1
              inc (Just x) = Just (x + 1)
              dec Nothing = Nothing
              dec (Just 1) = Nothing
              dec (Just x) = Just (x - 1)
  hPutBuilder stdout $ intDec result `mappend` charUtf8 '\n'

import Data.Maybe
import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import qualified Data.IntSet as IS
import System.IO

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

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

main :: IO ()
main = do
  _ <- getInts
  as <- getInts
  let (result, _, _) = foldl' acc (0, 0, IS.empty) as
      acc :: (Int64, Int64, IS.IntSet) -> Int -> (Int64, Int64, IS.IntSet)
      acc (num, hp, set) a
        | a >= 0 = (num + 1, hp + fromIntegral a, set)
        | hp + fromIntegral a < 0 = (num, hp', set')
        | otherwise = (num + 1, hp + fromIntegral a, IS.insert a set)
        where Just (a', set') = IS.minView $ IS.insert a set
              hp' = hp + fromIntegral a - fromIntegral a'
  hPutBuilder stdout $ int64Dec result `mappend` charUtf8 '\n'

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

main = do
    _ <- getLine
    a <- map read . words <$> getLine
    print $ solve S.empty 0 a

solve :: S.Set Int64 -> Int64 -> [Int64] -> Int
solve s h [] = 0
solve s h (x:xs)
    | h' >= 0 = 1 + solve s' h' xs
    | otherwise =
        let (y, s'') = S.deleteFindMin s'
         in solve s'' (h' - y) xs
  where
    s' = S.insert x s
    h' = h + x


{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

remulo :: Int
remulo = 10^9+7

a +. b = if c >= remulo then c - remulo else c where c = a+b
a -. b = a +. (remulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    mplus a b = if c >= m then c-m else c where c = a+b
    mminus a b = a `mplus` (m-b)
    mmul a b = a*b `rem` m

    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `rem` m) 1 :: UArray Int Int

    prev j d i = j `mminus` (d `mmul` (ps!i))

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i -> forM_ [0..m-1] $ \j ->
        let
          ds = if odd n == odd i then filter (/= d) [0..9] else [d]
          f' d = readArray a (i-1, j') where j' = prev j d (i-1)
        in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) +. (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 mplus $ zipWith (\x i -> x `mmul` (ps!(n-i))) ds [1..]

  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c

a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) +. (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(n-i) `mod` m) ds [1..]

  -- print cs
  -- print $ check b
  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c

a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    mplus a b = let c = a+b in if c >= m then c-m else c
    mminus a b = a `mplus` (m-b)
    mmul a b = a*b `mod` m

    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = j `mminus` (d `mmul` (ps!i))

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i -> forM_ [0..m-1] $ \j ->
        let
          ds = if odd n == odd i then filter (/= d) [0..9] else [d]
          f' d = readArray a (i-1, j') where j' = prev j d (i-1)
        in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) +. (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 mplus $ zipWith (\x i -> x `mmul` (ps!(n-i))) ds [1..]

  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array (Array)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, runSTArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = if c >= modulo then c - modulo else c where c = a+b
a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    mplus a b = if c >= m then c-m else c where c = a+b
    mminus a b = a `mplus` (m-b)
    mmul a b = a*b `mod` m

    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = j `mminus` (d `mmul` (ps!i))

    -- cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i -> forM_ [0..m-1] $ \j ->
        let
          ds = if odd n == odd i then filter (/= d) [0..9] else [d]
          f' d = readArray a (i-1, j') where j' = prev j d (i-1)
        in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) +. (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 mplus $ zipWith (\x i -> x `mmul` (ps!(n-i))) ds [1..]

  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

remulo :: Int
remulo = 10^9+7

a +. b = let c = a + b in if c >= remulo then c - remulo else c

a -. b = a +. (remulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    mplus a b = let c = a+b in if c >= m then c-m else c
    mminus a b = a `mplus` (m-b)
    mmul a b = a*b `rem` m

    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `rem` m) 1 :: UArray Int Int

    prev j d i = j `mminus` (d `mmul` (ps!i))

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i -> forM_ [0..m-1] $ \j ->
        let
          ds = if odd n == odd i then filter (/= d) [0..9] else [d]
          f' d = readArray a (i-1, j') where j' = prev j d (i-1)
        in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) +. (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 mplus $ zipWith (\x i -> x `mmul` (ps!(n-i))) ds [1..]

  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c

a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!i `mod` m) ds [1..]

  -- print cs
  print $ count b -. count a +. (if check b then 1 else 0)

import Control.Applicative ((<$>), (<*>))
import Data.Array (listArray, (!))
import Data.Int (Int64)
import Data.Char (ord)

newtype MInt = MInt Int64

modulo :: Int64
modulo = 10^9+7

instance Num MInt where
  MInt a + MInt b = let c = a + b in MInt $ if c >= modulo then c - modulo else c
  MInt a * MInt b = MInt $ a * b `mod` modulo
  negate (MInt a) = MInt $ modulo - a
  abs = id
  signum (MInt a) = if a == 0 then 0 else 1
  fromInteger a = MInt $ fromInteger $ a `mod` toInteger modulo

instance Show MInt where show (MInt a) = show a

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs = listArray ((0, 0), (n, m-1)) $ map (uncurry f) $ ((,) <$> [0..n] <*> [0..m-1])
      where
        f :: Int -> Int -> MInt
        f 0 0 = 1
        f 0 _ = 0
        f i j = sum $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
          where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f :: Int -> Int -> [Int] -> MInt
        f _ _ [] = 0 :: MInt
        f i j (x:xs) = (sum $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
      where
        ds = map (\c -> ord c - 48) s

  print $ count b - count a + (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Int (Int64)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int64
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c
a *. b = a * b `mod` modulo

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0 :: ST s (STUArray s (Int, Int) Int64)
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (sum <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    -- cs = listArray ((0, 0), (n, m-1)) $ map (f) $ ((,) <$> [0..n] <*> [0..m-1]) :: Array (Int, Int) Int64
    --   where
    --     f (0, 0) = 1
    --     f (0, _) = 0
    --     f (i, j) = foldl' (+.) 0 $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
    --       where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f :: Int -> Int -> [Int] -> Int64
        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(i-1) `mod` m) ds [1..]

  -- print cs
  print $ count b - count a + (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c

a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(n-i) `mod` m) ds [1..]

  -- print cs
  -- print $ check b
  print $ count b -. count a +. (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Int (Int64)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int64
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c
a -. b = let c = modulo + a - b in if c >= modulo then c- modulo else c

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0 :: ST s (STUArray s (Int, Int) Int64)
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (sum <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    -- cs = listArray ((0, 0), (n, m-1)) $ map (f) $ ((,) <$> [0..n] <*> [0..m-1]) :: Array (Int, Int) Int64
    --   where
    --     f (0, 0) = 1
    --     f (0, _) = 0
    --     f (i, j) = foldl' (+.) 0 $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
    --       where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f :: Int -> Int -> [Int] -> Int64
        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(i-1) `mod` m) ds [1..]

  -- print cs
  print $ count b -. count a +. (if check b then 1 else 0)

import Control.Applicative ((<$>), (<*>))
import Data.Array (listArray, (!))
import Data.Int (Int64)
import Data.Char (ord)

newtype MInt = MInt Int64

modulo :: Int64
modulo = 10^9+7

instance Num MInt where
  MInt a + MInt b = let c = a + b in MInt $ if c >= modulo then c - modulo else c
  MInt a * MInt b = MInt $ a * b `mod` modulo
  negate (MInt a) = MInt $ modulo - a
  abs = id
  signum (MInt a) = if a == 0 then 0 else 1
  fromInteger a = MInt $ fromInteger $ a `mod` toInteger modulo

instance Show MInt where show (MInt a) = show a

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs = listArray ((0, 0), (n, m-1)) $ map (uncurry f) $ ((,) <$> [0..n] <*> [0..m-1])
      where
        f :: Int -> Int -> MInt
        f 0 0 = 1
        f 0 _ = 0
        f i j = sum $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
          where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f :: Int -> Int -> [Int] -> MInt
        f _ _ [] = 0 :: MInt
        f i j (x:xs) = (sum $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = and $ zipWith (\x i -> if odd i then x == d else x /= d) ds [1..]
      where
        ds = map (\c -> ord c - 48) s

  print $ count b - count a + (if check b then 1 else 0)

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_, mapM)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c

a -. b = a +. (modulo - b)

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs :: UArray (Int, Int) Int
    cs = runSTUArray $ do
      a <- newArray ((0, 0), (n, m-1)) 0
      writeArray a (0, 0) 1

      forM_ [1..n] $ \i ->
        forM_ [0..m-1] $ \j ->
          let
            ds = if odd n == odd i then filter (/= d) [0..9] else [d]
            f' d = readArray a (i-1, j') where j' = prev j d (i-1)
          in (foldl (+.) 0 <$> mapM f' ds) >>= writeArray a (i, j)

      return a

    -- cs = listArray ((0, 0), (n, m-1)) $ map (f) $ ((,) <$> [0..n] <*> [0..m-1]) :: Array (Int, Int) Int64
    --   where
    --     f (0, 0) = 1
    --     f (0, _) = 0
    --     f (i, j) = foldl' (+.) 0 $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
    --       where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(i-1) `mod` m) ds [1..]

  -- print cs
  print $ count b -. count a +. (if check b then 1 else 0)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>), (<*>))
import Data.Array (Array)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Int (Int64)
import Data.List (foldl')
import Data.Char (ord)

modulo :: Int64
modulo = 10^9+7

a +. b = let c = a + b in if c >= modulo then c - modulo else c
a *. b = a * b `mod` modulo

main = do
  [m, d] <- map read . words <$> getLine
  a <- getLine
  b <- getLine

  let
    n = length a

    ps = listArray (0, n) $ iterate (\x -> x*10 `mod` m) 1 :: UArray Int Int

    prev j d i = (j - d*ps!i `mod` m + m) `mod` m

    cs = listArray ((0, 0), (n, m-1)) $ map (uncurry f) $ ((,) <$> [0..n] <*> [0..m-1]) :: Array (Int, Int) Int64
      where
        f :: Int -> Int -> Int64
        f 0 0 = 1
        f 0 _ = 0
        f i j = foldl' (+.) 0 $ map f' $ if odd n == odd i then filter (/= d) [0..9] else [d]
          where f' d = cs!(i-1, j') where j' = prev j d (i-1)

    count s = f 1 0 ds
      where
        ds = map (\c -> ord c - 48) s

        f :: Int -> Int -> [Int] -> Int64
        f _ _ [] = 0
        f i j (x:xs) = (foldl' (+.) 0 $ map f' ds) + (if b then f (i+1) j' xs else 0)
          where
            ds
              | i == 1 = filter (/= d) [1..x-1]
              | odd i = filter (/=d) [0..x-1]
              | even i = filter (== d) [0..x-1]

            f' d = cs!(n-i, j') where j' = prev j d (n-i)

            b = if odd i then x /= d else d == x
            j' = prev j x (n-i)

    check s = match && r == 0
      where
        ds = map (\c -> ord c - 48) s
        match = and $ zipWith (\x i -> if odd i then x /= d else x == d) ds [1..]
        r = foldl1 (\a b -> (a + b) `mod` m) $ zipWith (\x i -> x*ps!(i-1) `mod` m) ds [1..]

  print cs
  print $ count b - count a + (if check b then 1 else 0)


import Control.Monad

count = sum . map fromEnum

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, a, b] <- map read . words <$> getLine
    s <- getLine
    let len = length s
    print $ a * len + b * if b >= 0
                             then len
                             else (1 + count (zipWith (/=) s (tail s))) `div` 2 + 1

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

solve :: IO ()
solve = do
    [n, a, b] <- readMany :: IO [Int]
    s <- getLine
    let oneByOne = n * (a + b)
        g = length $ group s
        greedy = a * n + b * (g `div` 2 + 1)
    print $ if b < 0 then greedy else oneByOne

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group)
import Data.Maybe (fromJust, fromMaybe)

chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

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

testCase :: Scanner Int
testCase = do
  nab <- three int
  s <- C.unpack <$> str
  return $ solve nab s

solve [n, a, b] s
  | b >= 0 = n * (a + b)
  | otherwise = n * a + m * b
  where
    g = length $ group s
    m = 1 + (g `div` 2)

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io
--import Data.Char as C
--import Data.IntSet as S

cnt :: String -> Int -> Char -> Int
cnt [] k _ = div k 2 + 1
cnt (x:xs) k ch
  | x == ch = cnt xs k x
  | otherwise = cnt xs (k+1) x

solve :: IO ()
solve = do
  s_ <- getLine
  s <- getLine
  let [n,a,b] = map read $ words s_ :: [Int]
      total = (if b >= 0 then n * (a + b) else
                  n*a + (cnt s 0 '2')*b)
    in print total

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

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

solve [x] = 1
solve (x:xs) = solve xs + if x /= head xs then 1 else 0

printResult = do
    [n,a,b] <- readInts
    s <- getLine
    if b > 0 then print $ n*(a+b)
    else do
        let r = solve s
        print $ n * a + (div r 2 + 1) * b

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

count :: Integer -> Integer ->Integer -> String -> Integer
count n a b string
    | b >= 0 = (a + b) * n
    | otherwise = (((flips string) `div` 2) + ((flips string) `mod` 2) + 1)* b + n * a -- for deleting the first prefix
        where
            flips:: String -> Integer
            flips [] = 0
            flips [_] = 0
            flips (x:(y:xs))
                | x == y = flips (y:xs)
                | otherwise = flips (y:xs) + 1

main = do
    int <- getLine
    let t = read int::Integer
    repeat t
        where
            repeat 0 = return ()
            repeat m = do
                nab <- getLine
                let arr = map (\a -> read a::Integer) $ words nab
                string <- getLine
                print $ count (arr!!0) (arr!!1) (arr!!2) string
                repeat $ m - 1

count :: Integer -> Integer ->Integer -> String -> Integer
count n a b string
    | b >= 0 = (a + b) * n
    | otherwise = (((flips string) `div` 2) + ((flips string) `mod` 2)) * b + n * a
        where
            flips:: String -> Integer
            flips [] = 0
            flips [_] = 1
            flips (x:(y:xs))
                | x == y = flips (y:xs)
                | otherwise = flips (y:xs) + 1

main = do
    int <- getLine
    let t = read int::Integer
    repeat t
        where
            repeat 0 = return ()
            repeat m = do
                nab <- getLine
                let arr = map (\a -> read a::Integer) $ words nab
                string <- getLine
                print $ count (arr!!0) (arr!!1) (arr!!2) string
                repeat $ m - 1

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

solve :: IO ()
solve = do
    [n, a, b] <- readMany :: IO [Int]
    s <- getLine
    let oneByOne = n * (a + b)
        n' = length $ group s
        greedy = a * n + b * ((n' + 1) `div` 2)
    print $ if b <= 0 then greedy else oneByOne

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group)
import Data.Maybe (fromJust, fromMaybe)

chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

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

testCase :: Scanner Int
testCase = do
  nab <- three int
  s <- C.unpack <$> str
  return $ solve nab s

solve [n, a, b] s
  | b >= 0 = n * (a + b)
  | otherwise = n * a + m * b
  where
    m = (1 + length (group s)) `div` 2

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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


module Main where

import Control.Monad
import System.IO
import Data.Maybe
import Data.Char
import Data.List

data Token a = Add | End | For a
    deriving Show

isAdd :: Token a -> Bool
isAdd Add = True
isAdd _ = False

isEnd :: Token a -> Bool
isEnd End = True
isEnd _ = False

fromFor :: Token a -> a
fromFor Add = undefined
fromFor End = undefined
fromFor (For count) = count

parseToken :: String -> Maybe (Token Integer)
parseToken s
    | s == "add" = Just Add
    | s == "end" = Just End
    | otherwise =
        let ws = words s
            maybe_for = length ws == 2 && head ws == "for"
        in if maybe_for
            then Just $ For (read (head (tail ws)) :: Integer)
            else Nothing

topBound = 4294967295 :: Integer

progCalc :: [Token Integer] -> Maybe Integer
progCalc toks = progCalc' (Just 0) [] toks

progCalc' :: Maybe Integer -> [Maybe Integer] -> [Token Integer] -> Maybe Integer
progCalc' x _ [] = x
progCalc' Nothing _ _ = Nothing
progCalc' (Just x) levels (tok : resttoks)
    | isAdd tok && null levels =
        let z = x + 1
        in if z > topBound then Nothing
            else progCalc' (Just z) levels resttoks
    | isAdd tok =
        let lev = head levels
        in if isNothing lev then Nothing
            else let z = x + (fromJust lev)
            in if z > topBound then Nothing
                else progCalc' (Just z) levels resttoks
    | isEnd tok = progCalc' (Just x) (tail levels) resttoks
    | otherwise =
        let count = fromFor tok
            prevLev = if null levels then (Just 1) else head levels
        in if isNothing prevLev
            then progCalc' (Just x) (Nothing : levels) resttoks
            else let lev = (fromJust prevLev) * count
                in if lev > topBound
                    then progCalc' (Just x) (Nothing : levels) resttoks
                    else progCalc' (Just x) ((Just lev) : levels) resttoks

main :: IO()
main = do

    q <- readLn :: IO Int
    lines <- forM [1..q] $ \q_nxt -> do
        line <- getLine
        return line

    let toks = map (fromJust . parseToken) lines
    let result = progCalc toks
    let resultstr = if (isNothing result)
        then "OVERFLOW!!!"
        else show $ fromJust result

    putStrLn resultstr

import qualified Data.List as List

data Command = For Integer | Add | End
            deriving (Eq, Show)

data Instr =
    One Command
  | More [Instr]
  deriving (Eq, Show)

{- reduce the stack -}
turnOutermost :: [Instr] -> [Instr] -> [Instr]
turnOutermost [] acc = acc
turnOutermost (One End : rest) acc = turnOutermost rest (One End : acc)
turnOutermost (One Add : rest) acc  = turnOutermost rest (One Add : acc)
turnOutermost (More x : rest) acc = turnOutermost rest (More x : acc)
turnOutermost (One (For n) : rest) acc = More (One (For n) : acc) : rest

{- Shift and reduce -}
parseCommand :: [Command] -> [Instr] -> [Instr]
parseCommand [] stack = stack
parseCommand (Add : rest) stack
  | stack == [] =  One Add : parseCommand rest stack
  | otherwise = parseCommand rest (One Add : stack)
parseCommand(For n : rest) stack = parseCommand rest (One (For n) : stack)
parseCommand (End : rest) stack = ret where
    tw = turnOutermost (One End : stack) []
    ret = case tw of
           [x] -> x : parseCommand rest []
           _ -> parseCommand rest tw

evalCommand :: [Instr] -> Integer
evalCommand [] = 0
evalCommand (One Add : xs) = 1 + evalCommand xs
evalCommand (One End : xs) = evalCommand xs
evalCommand (One (For n) : xs) = n * evalCommand xs
evalCommand (More t : xs) = evalCommand t + evalCommand xs

solve :: [Command] -> String
solve xs = ret where
  rt = evalCommand (parseCommand xs [])
  ret = if rt > 4294967295 then "OVERFLOW!!!" else show rt

strCommand :: [String] -> Command
strCommand ["add"] = Add
strCommand ["end"] = End
strCommand ["for", n] = For (read n :: Integer)

main :: IO ()
main = interact $  solve . map (strCommand . words) . tail . lines


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

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

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

main = do
  getLine
  xs <- getInts

  let
    c = count (0 :: Int64) $ sort xs
      where
        count _ [] = 0
        count c (x:xs)
          | c > x' = count c xs
          | otherwise = 1 + count (c+x') xs
          where
            x' = fromIntegral x :: Int64

  print c

import Data.List (sort)
import System.IO

f (suma, ans) x =
    if suma <= x
       then (suma + x, ans + 1)
       else (suma, ans)

solve list =
    foldl f (0, 0) (sort list)

solution list = snd $ solve list

makeItInt a =
    read a :: Int

makeListGreatAgain l =
    map makeItInt $ lines $ map (\c -> if c == ' ' then '\n' else c) l

main = do
    n <- getLine
    l <- getLine
    putStrLn $ show (solution $ makeListGreatAgain l)

import Data.List (sort)
getNum [] waitTime = 0
getNum (ha:ta) waitTime | ha >= waitTime = 1+(getNum ta (waitTime+ha))
                        | otherwise = getNum ta waitTime
main = do
  w0 <- getLine
  w1 <- getLine
  let a = [read n::Int|n <-(words w1)]
  print $ getNum (sort a) 0

module Main where
import Data.List
-- import Debug.Trace

solve _ n [] = n
solve w n (t:ts) = -- trace ("t=" ++ show t ++ " w=" ++ show w ++ " n=" ++ show n) $
    if t >= w
        then solve (w+t) (n+1) ts
        else solve w n ts

main = do
    getLine
    is <- map (read :: String -> Int) .words <$> getLine
    print $ solve 0 0 $ sort is

import Data.List

foo :: [Int] -> Int -> Int -> Int
foo [] _ n = n
foo (x:xs) t n = if x<t then foo xs t n else foo xs (t+x) (n+1)

main :: IO ()
main = do
  n <- return . (read::String->Int) =<< getLine
  xs <- return . sort . map (read::String->Int) . words =<< getLine
  print $ foo xs 0 0

import Control.Applicative
import Data.List

process n s [] = n
process n s a |  b==[] = n
              |  otherwise = process (n+1) (s+ (head b)) (tail b)
    where b = dropWhile (<s) a
main::IO ()
main=do
    n<- read <$> getLine::IO Int
    a1<- sort <$>  map read <$>   words   <$> getLine:: IO [Int]
    print $ process 0 0 a1

import Data.List

main = do
	getLine
	l <- getLine >>= return.(map read).words
	putStrLn $ show $ solve (sort l) 0

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

import Control.Applicative ((<*>))
import Data.List (sort)

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

solve :: [Int] -> Int
solve = snd . foldl (\(a, b) c -> if a <= c then (a + c, b + 1) else (a, b)) (0, 0) . sort

import Data.List
main = interact $ show . solve 0 . sort . map read . tail . words
solve t (a:as) | t <= a = 1 + solve (t+a) as
               | otherwise = solve t as
solve _ [] = 0

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

process [] n u= n
process (s:ss) n u| u<=s = process ss (n+1) (u+s)
                  | otherwise= process ss n u
main= do
	getLine
	s<- sort . map (fst.fromJust.C.readInt). C.words <$> C.getLine :: IO [Int]
	print $ process s 0 0

import Data.List

main = interact $ show . sol 0 . sort . tail . map read . words

sol _ [] = 0
sol t (x:xs)
    | t <= x = 1 + sol (t+x) xs
    | otherwise = sol t xs

-- http://codeforces.com/problemset/problem/545/D

import Data.List

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

takeFirst :: (a -> Bool) -> [a] -> Maybe a
takeFirst f [] = Nothing
takeFirst f (x:xs)
	| f x = Just x
	| otherwise = takeFirst f xs

main = do
	n <- fmap read getLine :: IO Int
	people <-	fmap sort $
				fmap (map read) $
				fmap (take n) $
				fmap words getLine :: IO [Int]

	let
		not_dissapointed = notDissapointed people

	putStrLn $ show not_dissapointed

notDissapointed :: [Int] -> Int
notDissapointed xs = notDissapointed' 0 xs
	where
		notDissapointed' :: Int -> [Int] -> Int
		notDissapointed' acc people
			| not_dissapointed == 0 = 0
			| otherwise = 1 + notDissapointed' (acc + not_dissapointed) rest
			where
				not_dissapointed = eliminate 0 $ takeFirst (>=acc) people
				rest = delete not_dissapointed people
				eliminate :: a -> Maybe a -> a
				eliminate fallback Nothing = fallback
				eliminate _ (Just x) = x

-- http://codeforces.com/problemset/problem/545/D

import Data.List

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

takeFirst :: (a -> Bool) -> [a] -> Maybe a
takeFirst f [] = Nothing
takeFirst f (x:xs)
	| f x = Just x
	| otherwise = takeFirst f xs

main = do
	n <- fmap read getLine :: IO Int
	people <-	fmap sort $
				fmap (map read) $
				fmap (take n) $
				fmap words getLine :: IO [Int]

	let
		not_dissapointed = notDissapointed people

	putStrLn $ show not_dissapointed

notDissapointed :: [Int] -> Int
notDissapointed xs = notDissapointed' 0 xs
	where
		notDissapointed' :: Int -> [Int] -> Int
		notDissapointed' acc people
			| not_dissapointed == 0 = 0
			| otherwise = 1 + notDissapointed' (acc + not_dissapointed) rest
			where
				not_dissapointed = eliminate 0 $ takeFirst (>acc) people
				rest = delete not_dissapointed people
				eliminate :: a -> Maybe a -> a
				eliminate fallback Nothing = fallback
				eliminate _ (Just x) = x

module Main where
import Data.List

main = do
    getLine
    is <- map (read :: String -> Int) .words <$> getLine
    let ss = sort is
        ts = scanl' (+) 0 ss
    print $ length $ filter (\(a,b) -> a >= b) $ zip ss ts

module Main where
import Data.List

main = do
    getLine
    is <- map (read :: String -> Int) .words <$> getLine
    let patience = sort is
        waiting = scanl' (+) 0 patience
    --print $  zip patience waiting
    print $ succ $ length $ filter (\(p,w) -> p >= w) $ zip (tail patience) (tail waiting)

import Control.Applicative
import Data.List

main::IO ()
main=do
    n<- read <$> getLine::IO Int
    a1<- sort <$>  map read <$>   words   <$> getLine:: IO [Int]
    let a2 = scanl1 (+) a1
    print $ (+1)$ length $ filter (\(z1,z2)-> z1<=z2)  $ zip a2 (tail a1)

import Control.Applicative ((<*>))
import Data.List (sort)

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

solve :: [Int] -> Int
solve = length . filter id . (zipWith (>=) <*> scanl (+) 0) . sort

import Data.List
main = interact $ show . solve . sort . map read . tail . words
solve as = sum $ zipWith ((fromEnum .) . (<=)) (scanl (+) 0 as) as

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

main= do
	getLine
	s<- sort . map (fst.fromJust.C.readInt). C.words <$> C.getLine :: IO [Int]
	let t = scanl (+) 0 s
	print $ length $ filter (\z-> fst z >= snd z) $ zip s t


import           Control.Monad

crust :: (Int, Int) -> (Int, Int, Int) -> Bool
crust (r, d) (x, y, r') = fromIntegral (r - d) <= dist - fromIntegral r' && fromIntegral r >= dist + fromIntegral r'
  where dist = sqrt (fromIntegral (x^2 + y^2) :: Double)

main :: IO ()
main = do
  [r, d] <- map (read :: String -> Int) . words <$> getLine
  n <- (read :: String -> Int) <$> getLine
  print =<< length . filter (crust (r, d)) . map((\[x,y,r]->(x,y,r)) . map (read :: String -> Int) . words) <$> replicateM n getLine

import Control.Applicative( (<$>))
import Control.Monad( replicateM)

main = do
    [r_, d_] <- map read . words <$> getLine
    n_ <- readLn::IO Int
    sausageInfos_ <- replicateM n_ (map read . words <$> getLine)
    let

	disSq x y = x^2 + y^2

	check [x,y,ri] = let
			    dis2 = disSq x y
			in
			    (r_-d_+ri)^2 <= dis2 &&
				dis2 <= (r_-ri)^2

    print . length $ filter check sausageInfos_

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy

main = putStr . evalState app . B.words =<< B.getContents

app = do
  r <- poi
  d <- poi
  n <- poi
  ss <- replicateM n $ liftM3 (,,) poi poi poi
  return $ show $ solve r d ss
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve r d = length . filter ok
  where
  ok (x, y, r') = o <= (r - r')^2 && o >= (r - d + r')^2
    where o = x*x + y*y

import Data.List
import Data.Ord

{-

solve l r x y k
	|l/y<=k && r/x>=k = solve1 l r x y k
	|otherwise = "NO"
solve1 l r x y k
	|or (map (\a->bin a x y k) [l..r] ) = "YES"
	|otherwise = "NO"

bin a x y k
	|x>y = False
	|a/x==k = True
	|a/y==k = True
	|2*a/(y+x)<k = bin a x ((y+x)/2) k
	|otherwise = bin a ((y+x)/2) y k

main=do
	word<-getLine
	let [l,r,x,y,k]=map (\x->read x::Float) $ words word
	putStrLn (solve l r x y k)

-}

fi=fromIntegral

hip x y=sqrt ((fi x)^2 + (fi y)^2)
check r d x y r1 = ((h-fi r1)>=fi (r-d)) && ((h+fi r1)<=fi r) where
 h=hip x y

toNArr x = map (\x->read x::Int) $ words x

extract (x:y:xs)=(r,d,circles) where
	[r,d]=toNArr x
	n=read y::Int
	circles=map toNArr $ take n xs

solve (r,d,circles)=length $ filter (\(x:y:r1:_)->check r d x y r1) circles

main=interact$show.solve.extract.lines

sqrtm = sqrt . (fromIntegral :: Int -> Double)

fun :: Int -> Int -> [Int] -> Int
fun _ _ [] = 0
fun r l x@(a : b : c :xz) = do
				let n = sqrtm (a * a + b * b)

				if n - fromIntegral c >= fromIntegral l && n + fromIntegral c <= fromIntegral r then 1 + fun r l xz else fun r l xz

main = do
	str <- getContents
	let cont = (map (\x -> read x :: Int). words) str
	let (r:l:n) = take 3 cont
	let newcont = drop 3 cont
	print $ fun r (r - l) newcont

sqrtm = sqrt . (fromIntegral :: Int -> Double)

fun :: Int -> Int -> [Int] -> Int
fun _ _ [] = 0
fun r l x@(a : b : c :xz) = do
				let n = sqrtm (a * a + b * b)

				if n - fromIntegral c >= fromIntegral l && n + fromIntegral c <= fromIntegral r then 1 + fun r l xz else fun r l xz

main = do
	str <- getContents
	let cont = (map (\x -> read x :: Int). words) str
	let (r:l:n) = take 3 cont
	let newcont = drop 3 cont
	print $ fun r l newcont


{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (xs : rest) = solve xs : process rest

solve :: String -> String
solve cs = take (length cs) $ repeat $ win $ snd $ last $ sort $ map (\xs-> (length xs, head xs)) $ group $ sort cs where
      win 'S' = 'R'
      win 'R' = 'P'
      win 'P' = 'S'

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

main = getLine >>= flip replicateM_ test . read

test = do
  s <- getLine
  putStrLn $ replicate (length s) $
    case head $ maximumBy (comparing length) $ group $ sort s of
      'R' -> 'P'
      'P' -> 'S'
      _ -> 'R'

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (xs : rest) = solve xs : process rest

solve :: String -> String
solve cs = take (length cs) $ repeat $ win $ fst $ last $ sort $ map (\xs-> (head xs, length xs)) $ group $ sort cs where
      win 'S' = 'R'
      win 'R' = 'P'
      win 'P' = 'S'


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

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

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

main = do
  getLine
  xs <- getInts

  let
    ys = map (\g -> (head g, length g)) $ group xs

    (r0, k0, d0) = (ys2, length ys1, sum $ map snd ys1)
      where
        (ys1, ys2) = span (\x -> fst x == a || fst x == b) ys
        ((a, _):(b, _):_) = ys

    scan :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> Int
    scan [_] _ _ m = m
    scan _ [] _ m = m
    scan l r k m = scan l' r' k' $ max d' m
      where
        l' = drop (k-1) l
        (a, _) = head l'
        (b, _) = head r
        (r1, r') = span (\x -> fst x == a || fst x == b) r
        k' = 1 + length r1
        d' = snd (head l') + sum (map snd r1)

  print $ if length ys == 1 then snd $ head ys else scan ys r0 k0 d0

import Control.Applicative
import Debug.Trace

solve :: Int -> Int -> Int -> Int -> [Int] -> Int
solve _ cntp cntn ans [_] = max ans $ cntp + cntn
solve pre cntp cntn ans (x:y:ys)
    | x == y = trace (show $ cntp + cntn) $ solve pre cntp (cntn+1) ans (y:ys)
    | pre == 0 || pre == y = trace (show $ cntp + cntn) $ solve x (cntp+cntn) 1 ans (y:ys)
    | otherwise = trace (show $ cntp + cntn) $ solve x cntn 1 (max ans $ cntp+cntn) (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    as <- map read . words <$> getLine
    print $ solve 0 0 1 0 as

import Control.Applicative

solve :: Int -> Int -> Int -> Int -> [Int] -> Int
solve _ cntp cntn ans [_] = max ans $ cntp + cntn
solve pre cntp cntn ans (x:y:ys)
    | x == y = solve pre cntp (cntn+1) ans (y:ys)
    | pre == 0 || pre == y = solve x (cntp+cntn) 1 ans (y:ys)
    | otherwise = solve x cntn 1 (max ans $ cntp+cntn) (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    as <- map read . words <$> getLine
    print $ solve 0 0 0 0 as


{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let ~(lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | Triple i' x' il' <- lts], Triple i x il:ges)) (0, [Triple 0 hi 0]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = sum $ snd $ mapAccumL (\s (i, x) -> let ~(lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (Triple i x il:ges, sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') | Triple i' x' il' <- lts])) [Triple 0 hi 0] (zip [1..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let (lts, ges@((il, _, _):_)) = span (\(_, x', _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | (i', x', il') <- lts], (i, x, il):ges)) (0, [(0, hi, 0)]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = sum $ snd $ mapAccumL (\s (i, x) -> let (lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (Triple i x il:ges, sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') | Triple i' x' il' <- lts])) [Triple 0 hi 0] (zip [1..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

data Triple = Triple {-# UNPACK #-} !Int {-# UNPACK #-}  !Int {-# UNPACK #-} !Int

comp :: Int -> [Int] -> Int64
comp hi xs = fst $ foldl' (\(!acc, s) (i, x) -> let (lts, ges@(Triple il _ _:_)) = span (\(Triple _ x' _) -> x' < x) s in (acc + sum [fromIntegral x' * fromIntegral (i' - il') * fromIntegral (i - i') :: Int64 | Triple i' x' il' <- lts], Triple i x il:ges)) (0, [Triple 0 hi 0]) (zip [(1 :: Int)..] $ xs ++ [hi])

solve xs = comp 1000001 xs + comp 0 (map negate xs)

main = do
  _ <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier !Int64  !Int64  !Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Int]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = let x' = fromIntegral x in case l of
    [] -> (acc + cx * x', [Tier x cx (x' * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x' + my, Tier x cx (x' * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int64 {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier {-# UNPACK #-} !Int {-# UNPACK #-}  !Int64 {-# UNPACK #-} !Int64

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Int]->Int64
maxSums = go 1 0 [] where
  go _  acc _ [] = acc
  go cx acc l xs@(x: rest) = let x' = fromIntegral x in case l of
    [] -> go 1 (acc + cx * x') [Tier x cx (x' * cx)] rest
    Tier y cy my : ys
      | x >= y    -> go (cx + cy) acc ys xs
      | otherwise -> go 1 (acc + cx * x' + my) (Tier x cx (x' * cx + my) : l) rest

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.Int

data Tier = Tier Int64 Int64 Int64

getInts::IO [Int64]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> fromInteger x : go (BS.drop 1 s')

maxSums::[Int64]->Int64
maxSums = fst. foldr (next 1) initial where
  initial = (0, [])
  next cx x (acc, l) = case l of
    [] -> (acc + cx * x, [Tier x cx (x * cx)])
    Tier y cy my : ys
      | x >= y    -> next (cx + cy) x (acc, ys)
      | otherwise -> (acc + cx * x + my, Tier x cx (x * cx + my) : l)

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve xs = fin l1 r1 - fin l0 r0
  where
    n = length xs
    zs = zip [1..] xs
    rzs = reverse zs
    lo = 0
    hi = 10^(6 :: Int) + 1
    l0 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((> x) . snd) s in (a:s', head s')) [(0, lo)] zs
    r0 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((>= x) . snd) s in (a:s', head s')) [(n + 1, lo)] rzs
    l1 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((< x) . snd) s in (a:s', head s')) [(0, hi)] zs
    r1 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((<= x) . snd) s in (a:s', head s')) [(n + 1, hi)] rzs
    fin ls rs = sum $ zipWith (\(i, x) (l, r) -> x * (i - l) * (r - i)) zs $ zip ls rs

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve xs = fin l1 r1 - fin l0 r0
  where
    n = length xs
    zs = zip [1..] xs
    rzs = reverse zs
    lo = 0
    hi = 10^(6 :: Int) + 1
    l0 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((> x) . snd) s in (a:s', head s')) [(0, lo)] zs
    r0 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((>= x) . snd) s in (a:s', head s')) [(n + 1, lo)] rzs
    l1 = map fst $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((< x) . snd) s in (a:s', head s')) [(0, hi)] zs
    r1 = map fst $ reverse $ snd $ mapAccumL (\s a@(_, x) -> let s' = dropWhile ((<= x) . snd) s in (a:s', head s')) [(n + 1, hi)] rzs
    fin ls rs = sum $ zipWith (\(i, x) (l, r) -> fromIntegral $ x * (i - l) * (r - i) :: Int64) zs $ zip ls rs

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  print $ solve xs

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List

getInts::IO [Integer]
getInts = go <$> BS.getLine where
  go s = case  BS.readInteger s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

maxSums::[Integer]->Integer
maxSums = fst. foldl' (next 1) initial where
  initial = (0, [])
  next cx u@(acc, (y, cy) : ys) x
    | x >= y    = next (cx + cy) (acc, ys) x
    | otherwise = (acc + cx * x + (cx * cy) * y, (x, cx) : (y, cy) : ys)
  next cx (acc, []) x =  (acc + cx * x, [(x, cx)])

main :: IO ()
main = do
  void getLine
  xs <- getInts
  print $  maxSums xs + maxSums (fmap negate xs)


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

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  filter (not . null) >>>
  map (words >>> map read) >>> process >>> map (bool "No" "Yes") >>> unlines

process :: [[Int]] -> [Bool]
process [] = []
process ([_, x]:xs:ys:xss) = solve x xs ys : process xss

solve :: Int -> [Int] -> [Int] -> Bool
solve x xs ys = all (<= x) $ zipWith (+) xs' ys'
  where
    xs' = sort xs
    ys' = reverse . sort $ ys

module Main where

import Data.List
import Control.Monad

solveCase :: (Int, [Int], [Int]) -> Bool
solveCase (x, a, b) = all (<= x) $ zipWith (+) (sort a) (reverse $ sort b)

readCase :: IO (Int, [Int], [Int])
readCase = do
  [_, x] <- map read . words <$> getLine
  a <- map read . words <$> getLine
  b <- map read . words <$> getLine
  return (x, a, b)

main = do
  t <- read <$> getLine
  cases <- (:) <$> readCase <*> replicateM (t - 1) (getLine *> readCase)
  mapM_
    (\x ->
       putStrLn $
       if solveCase x
         then "Yes"
         else "No")
    cases

import qualified Data.Sequence as S

type Description = (Int, Int, [Int], [Int])

getTestDesc :: Bool -> IO Description
getTestDesc ign = do
  [n, x] <- getArr
  a <- getArr
  b <- getArr
  _ <- if ign then getLine else pure ""
  return (n, x, a, b)
  where getArr = getLine >>= pure . map read . words

solveTest :: Description -> String
solveTest (n, x, a, b) = if rz then "Yes" else "No"
  where seq c = S.sortBy c . S.fromList
	sa = seq compare a
	sb = seq (flip compare) b
	sz = S.zipWith (+) sa sb
	rz = foldl (&&) True . fmap (\u -> u <= x) $ sz

main :: IO ()
main = do
  t <- pure . read =<< getLine
  _ <- sequence $ replicate (t - 1) (getTestDesc True >>= putStrLn . solveTest)
  _ <- getTestDesc False >>= putStrLn . solveTest
  return ()

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

main :: IO ()
main = runNTestCases runTest

runTest :: IO ()
runTest = do
  (_, x) <- read2
  _a <- getLine
  _b <- getLine
  let a = (map read . words) _a
      b = (map read . words) _b
      ans = solve x a b
  putStrLn ans
  eof <- isEOF
  if eof
    then return ()
    else getLine >> return ()

solve :: Int -> [Int] -> [Int] -> String
solve x a b = if isImpossible x a b
              then "No"
              else "Yes"

isImpossible :: Int -> [Int] -> [Int] -> Bool
isImpossible x a b = any (\(_a, _b) -> _a + _b > x) $ zip (sort a) (reverse $ sort b)

runNTestCases :: IO () -> IO ()
runNTestCases f = do
  n <- read'
  replicateM_ n f

read' :: (Read a) => IO a
read' = do
  _ln <- getLine
  return (read _ln)

read2 :: (Read a) => IO (a, a)
read2 = do
  _ln <- getLine
  let [x1, x2] = (map read . words) _ln
  return (x1, x2)


valid :: [Int] -> Bool
valid [] = True
valid [_] = True
valid (a:b:ls)
    | b == a+1      = valid (b:ls)
    | b < a         = valid (b:ls)
    | otherwise     = False

parse :: String -> [Int]
parse = map read . words

solve :: [String] -> [String]
solve [] = []
solve (_:pLine:rest)
    | valid ps      = "YES": solve rest
    | otherwise     = "NO" : solve rest
    where
        ps = parse pLine

main :: IO ()
main = interact $ unlines . solve . tail . lines

import Control.Monad

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

routine :: IO ()
routine = do
    _ <- getLine
    as <- (map read.words) <$> getLine
    putStrLn $ if solve as
      then "Yes"
      else "No"

solve :: [Int] -> Bool
solve as = start (1,xs)
  where xs = reverse as

middle :: (Int,Int,Int,[Int]) -> Bool
middle (ziel,nächstesZiel,prev,x:xs)
  | prev==x+1 = if x == ziel
    then start (nächstesZiel,xs)
    else middle (ziel,nächstesZiel,x,xs)

  | otherwise = False
middle _ = undefined

start :: (Int,[Int]) -> Bool
start (altesZiel,x:xs)
  | altesZiel == x = start (x+1,xs)
  | otherwise = middle (altesZiel,x+1,x,xs)
start _ = True


{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM_)
import Data.Char (ord)
import Data.List (sortOn, sort)
import Data.Ord (Down (Down))

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0
parseInts = fmap parseInt . words

main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum $ do
    n <- fmap parseInt getLine
    a <- fmap parseInts getLine
    let b = sortOn Down a
    print (min (length b - 2) (b !! 1 - 1))

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    print $ min ((sort str !! (x - 2)) - 1) (x - 2)

import Data.Char
import System.IO

-- reading functions

strToIntList :: String -> [Int]
strToIntList xs = map toInt (split xs ' ')

toInt :: String -> Int
toInt [] = 0
toInt (x:xs) = (digitToInt x) * 10^(length xs)  + toInt xs

-- first :: String -> Char -> String

split :: String -> Char -> [String]
split [] _ = []
split xs c = (first xs c) : split (rest xs c) c where
                            first [] c = []
                            first (x:xs) c| x==c = []
                                            | otherwise = x : first xs c
                            rest [] c = []
                            rest (x:xs) c| x==c = xs
                                         | otherwise = rest xs c

-- solving functions

maxL :: Ord a => [a] -> a
maxL (x:[]) = x
maxL (x:xs) = max x (maxL xs)

getOneOut :: Eq a => a -> [a] -> [a]
getOneOut x [] = []
getOneOut x (y:ys)| x==y = ys
                  | otherwise = y: (getOneOut x ys)

max2L :: Ord a => [a] -> a
max2L xs = maxL (getOneOut (maxL xs) xs)

solve :: [Int] -> Int
solve xs = min ((max2L xs)-1) (max 0 (length xs)-2)

solveN :: Int -> IO ()
solveN 0 = return ()
solveN n =    do
                getLine
                t  <- getLine
                (putStrLn . show . solve . strToIntList) t
                solveN (n-1)

solveNf :: Int -> Handle -> IO ()
solveNf 0 h = return ()
solveNf n h =  do
                hGetLine h
                t  <- hGetLine h
                (putStrLn . show . solve . strToIntList) t
                solveNf (n-1) h

main :: IO ()
main = do
            -- h <- openFile "A.in" ReadMode
            t <- hGetLine stdin
            solveNf (toInt t) stdin

            -- hClose h
            return ()

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    print $ (sort str !! (x - 2)) - 1

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ const $ do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    let srt = sort str
    print $ (srt !! (x - 2)) - 1

import Control.Monad
import Data.List

main = do
  n <- read <$> getLine
  forM_ [1..n] $ \_ -> do
    x <- read <$> getLine
    str <- (read <$>) <$> words <$> getLine
    let srt = sort str
    print $ (srt !! (x - 2)) - 1