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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (takeWhile (>= 0) $ iterate (subtract 1) (target-s)) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, origX] <- readInts
  pLi <- readInts
  let
    x = min origX (n - origX)
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    isLeaf :: UArray Int Bool
    isLeaf = accumArray (\_ _ -> False) True (1, n) $ zip pLi (repeat ())
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = if  x == origX
          then  accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
          else  accumArray (\_ _ -> 'b') 'a' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    imperfectSoln = let
      go 0 0 [] = []
      go _ _ [] = error "???"
      go asLeft bsLeft (v:vs) = let
        currLen = length v
        currLeaves = filter (isLeaf !) v
        currLeafCt = length currLeaves
        currNonLeaves = filter (not . (isLeaf !)) v
        in  if  currLen <= asLeft
        then  v ++ go (asLeft - currLen) bsLeft vs
        else  if  currLen <= bsLeft
        then       go asLeft (bsLeft - currLen) vs
        else  if  currLeafCt >= asLeft
        then  take asLeft currLeaves
        else  if  currLeafCt >= bsLeft
        then  drop bsLeft currLeaves ++ currNonLeaves ++ concat vs
        else  error "this shouldn't be possible"
      in  go x (n-x) $ elems findByDepth
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1, toByteString imperfectSoln)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, origX] <- readInts
  pLi <- readInts
  let
    x = min origX (n - origX)
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    isLeaf :: UArray Int Bool
    isLeaf = accumArray (\_ _ -> False) True (1, n) $ zip pLi (repeat ())
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = if  x == origX
          then  accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
          else  accumArray (\_ _ -> 'b') 'a' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    imperfectSoln = let
      go 0 0 [] = []
      go _ _ [] = error "???"
      go asLeft bsLeft (v:vs) = let
        currLen = length v
        currLeaves = filter (isLeaf !) v
        currLeafCt = length currLeaves
        currNonLeaves = filter (not . (isLeaf !)) v
        in  if  currLen <= asLeft
        then  v ++ go (asLeft - currLen) bsLeft vs
        else  if  currLen <= bsLeft
        then       go asLeft (bsLeft - currLen) vs
        else  if  currLeafCt >= asLeft
        then  take asLeft currLeaves
        else  if  currLeafCt >= bsLeft
        then  drop bsLeft currLeaves ++ currNonLeaves ++ concat vs
        else  error "this shouldn't be possible"
      in  go x (n-x) $ elems findByDepth
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1, toByteString imperfectSoln)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str
  let
    as = P.filter (== 'a') str
  when (P.length as /= fromIntegral x) $ lift . P.putStrLn . P.pack $ "Yikes"

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, x] <- readInts
  pLi <- readInts
  let
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    isLeaf :: UArray Int Bool
    isLeaf = accumArray (\_ _ -> False) True (1, n) $ zip pLi (repeat ())
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    imperfectSoln = let
      go 0 0 [] = []
      go _ _ [] = error "???"
      go asLeft bsLeft (v:vs) = let
        currLen = length v
        currLeaves = filter (isLeaf !) v
        currLeafCt = length currLeaves
        in  if  currLen <= asLeft
        then  v ++ go (asLeft - currLen) bsLeft vs
        else  if  currLen <= bsLeft
        then       go asLeft (bsLeft - currLen) vs
        else  if  currLeafCt >= asLeft
        then  take asLeft currLeaves
        else  if  currLeafCt >= bsLeft
        then  drop bsLeft currLeaves ++ concat vs
        else  error "this shouldn't be possible"
      in  go x (n-x) $ elems findByDepth
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1, toByteString imperfectSoln)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, x] <- readInts
  pLi <- readInts
  let
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    imperfectSoln = let
      go as xleft [v] = take xleft v ++ as
      go _ _ [] = error "???"
      go as xleft (v:vs) = let
        newxleft = xleft - length v
        in  if  newxleft >= 0
        then  go (v ++ as) newxleft vs
        else  go as xleft vs -- old xleft, intentional
      in  go [] x $ elems findByDepth
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1, toByteString imperfectSoln)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, x] <- readInts
  pLi <- readInts
  let
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1,
                  toByteString . take x . concat $ elems findByDepth)
  let
    count li = let
      av = elem 'a' $ P.index str . fromIntegral . (subtract 1) <$> li
      bv = elem 'b' $ P.index str . fromIntegral . (subtract 1) <$> li
      in  case  (av, bv)  of
      (False, False) -> error "huh?"
      (True, True) -> 2
      _ -> 1
    approxScore = sum [count li | li <- elems findByDepth, not (null li)]
  -- This should be triggered if there are the wrong number of distinct strings
  -- If this doesn't activate on test case 12 I will be very confused
  -- But I haven't been able to trigger it on random test data, either...
  when (score /= approxScore) $ lift . P.putStrLn $ P.pack "Yikes\n"
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, x] <- readInts
  pLi <- readInts
  let
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    toByteString :: [Int] -> P.ByteString
    toByteString li = let
        arr :: UArray Int Char
        arr = accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
        in  P.pack $ elems arr
    (score, str) = case  solution  of
      Just li -> (maxDepth, toByteString li)
      Nothing -> (maxDepth + 1,
                  toByteString . take x . concat $ elems findByDepth)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST

type SIO = StateT P.ByteString IO

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

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

data Tree t = Leaf t | Node !Int (Tree t) (Tree t) deriving (Eq, Show)

size :: Tree t -> Int
size (Leaf _) = 1
size (Node sz _ _) = sz

unite :: Tree t -> Tree t -> Tree t
unite x y = Node (size x + size y) x y

fromList :: [t] -> Tree t
fromList [] = error "fromList []"
fromList [x] = Leaf x
fromList (x:xs) = unite (Leaf x) $ fromList xs

toList :: Tree t -> [t]
toList = let
  go (Leaf x) = (x :)
  go (Node _ x y) = go x . go y
  in  flip go []

pairUp :: [Tree t] -> ([Tree t], [Tree t])
pairUp (x : y : zs@(_ : _)) = let
  (zpairs, unpaired) = pairUp zs
  in  (unite x y : zpairs, unpaired)
pairUp li = ([], li)

reduce :: [Tree t] -> [Tree t]
reduce [] = []
reduce li = runST $ do
  let  totSz = sum $ map size li
  arr <- newArray (1, totSz) [] :: ST s (STArray s Int [Tree t])
  forM_ li $ \v -> do
    let currSz = size v
    prev <- readArray arr currSz
    writeArray arr currSz (v : prev)
  forM_ [1..totSz] $ \currSz -> do
    szOpts <- readArray arr currSz
    let  (paired, unpaired) = pairUp szOpts
    writeArray arr currSz unpaired
    when (not $ null paired) $ do
      nextOpts <- readArray arr (2*currSz)
      -- (++) isn't cheap here, but it's only O(n * log n) complete
      -- cost, so not worth using some abstraction to avoid its overhead
      writeArray arr (2*currSz) $ paired ++ nextOpts
  allOpts <- getElems arr
  pure $ concat allOpts

solve :: [Tree Int] -> Int -> Maybe [Int]
solve options target = let
  memo = runSTUArray $ do
    arr <- newArray (0, target) 0 :: ST s (STUArray s Int Int)
    writeArray arr 0 (0-1)
    forM_ options $ \currOpt -> do
      let  s = size currOpt
      forM_ (reverse [0 .. target-s]) $ \i -> do
        prevStep <- readArray arr i
        when (prevStep /= 0) $ do
          oldVal <- readArray arr (i+s)
          writeArray arr (i+s) $ if  oldVal > 0  then  oldVal  else  s
    pure arr
  go 0 = Just []
  go k = let
    s = memo ! k
    in  if  s == 0
      then  Nothing
      else  (s :) <$> go (k - s)
  collectResult [] _ = []
  collectResult (sz : szs) toSearch
    = case  dropWhile (\x -> size x /= sz) toSearch  of
    [] -> error "not found?!"
    curr : rest -> toList curr ++ collectResult szs rest
  in  do
  sizes <- go target
  pure $ collectResult (reverse sizes) options

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, x] <- readInts
  pLi <- readInts
  let
    depths :: Array Int Int
    depths = listArray (1, n) $ 1 : map (\p -> 1 + depths ! p) pLi
    maxDepth = maximum $ elems depths
    findByDepth :: Array Int [Int]
    findByDepth = accumArray (flip (:)) [] (1, maxDepth)
                  [(d, ix) | (ix, d) <- assocs depths]
    unreducedOptions = [fromList li | li <- elems findByDepth, not $ null li]
    options = reduce unreducedOptions
    solution = solve options x
    [n64, x64] = map fromIntegral [n, x]
    (score, str) = case  solution  of
      Nothing -> (maxDepth + 1,
                  P.concat [P.replicate x64 'a', P.replicate (n64 - x64) 'b'])
      Just li -> let
        arr :: UArray Int Char
        arr = accumArray (\_ _ -> 'a') 'b' (1, n) $ zip li (repeat ())
        in  (maxDepth, P.pack $ elems arr)
  lift . P.putStrLn . P.pack $ show score
  lift . P.putStrLn $ str


import Data.List
findem l = [(l !! 3) - (l !! 0), (l !! 3) - (l !! 1), (l !! 3) - (l !! 2)]
analyze = findem . sort
ans = unwords . (map show) . analyze . (map read) . words
main = getLine >>= putStrLn . ans

import Data.List
main = interact $ unwords . map show . solve . map read . words
solve ns = delete 0 (map (abc -) ns) where
  abc = maximum ns

main =
    getLine >>= \line ->
    let nums = map read $ (words line) :: [Int] in
    let sum_vals = foldl max 0 nums in
    let vals = [sum_vals - x | x <- nums, x /= sum_vals] in
    putStrLn $ unwords $ map show vals

import Data.List
f a = map (\x -> maximum a - x) a
main = interact $ unwords . map show . delete 0 . f . map read . words

import Data.List
import Text.Printf
getList :: IO [Int]
getList = do
    input <- getLine
    let nums = words input
    return $ map read nums

main :: IO()
main = do
    list <- fmap sort getList
    let ans = map (\x -> list!!3-x) (init list)
    putStrLn $ unwords . map show $ ans

module Main where

printSolution :: [Int] -> IO ()
printSolution ints  = sequence_ $ fmap putStr $ fmap (\s -> show s ++ " ") ints

main = do
  let toNumbers line = (map read $ words line) :: [Int]
  row <- fmap toNumbers getLine

  let   solution = filter (/=0) $ map  (\x -> maximum row - x) row
  printSolution solution

{-# LANGUAGE ScopedTypeVariables #-}

main :: IO ()
main = do
  input <- getLine
  let numbers :: [Int] = read <$> words input
  let total = maximum numbers
  let answers = (total -) <$> filter (/= total) numbers
  putStrLn . unwords  $ show <$> answers

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

main= do
		a<- map read <$> words <$> getLine ::IO [Int]
		let m = maximum a
		putStrLn $ intercalate " " $ map  show $ tail $ sort $ map (\z->m-z) a

main = do
  [x1, x2, x3, x4] <- (map read . words) `fmap` getLine :: IO[Integer]
  let allSum = maximum [x1, x2, x3, x4]
  let [a, b, c] = filter (/=0) $ map ((-) allSum) [x1, x2, x3, x4]
  putStrLn $ (show a) ++ " " ++ (show b) ++ " " ++ (show c)

--ghc 7.10

reorder :: (Int,Int,Int,Int) -> (Int,Int,Int,Int)
reorder (x1, x2, x3, x4)
    | x1 + x2 + x3 == 2*x4 = (x1, x2, x3, x4)
    | x1 + x2 + x4 == 2*x3 = (x1, x2, x4, x3)
    | x1 + x3 + x4 == 2*x2 = (x1, x3, x4, x2)
    | x2 + x3 + x4 == 2*x1 = (x2, x3, x4, x1)
    | otherwise = (x1, x2, x3, x4)

restore :: (Int,Int,Int,Int) -> (Int,Int,Int)
restore x = (a,b,c)
    where
        (a'b,b'c,c'a,a'b'c) = reorder x
        c = a'b'c - a'b
        a = a'b'c - b'c
        b = a'b'c - c'a

main = do
    line <- getLine
    let [x1,x2,x3,x4] = map read . words $ line :: [Int]
    let (a,b,c) = restore (x1,x2,x3,x4)
    putStrLn . unwords . map show $ [a,b,c]

{-# OPTIONS_GHC -O2 #-}

import Data.List (sort)

main :: IO ()
main = do
  list@[x, y, z, w] <- fmap (sort . map read . words) getLine :: IO [Int]

  let abc = w
      a   = abc - x
      b   = abc - y
      c   = abc - z

  putStrLn . unwords $ map show [a, b, c]

import Data.List

solve [a, b, c, d] = map show [d - a, d - b, d - c]

main :: IO ()
main = do
    line <- getLine
    let xs = map read $ words line :: [Int]
    putStrLn $ intercalate " " $ solve $ sort xs

import Data.List (sort)

main = do
    line <- getLine
    let arr = sort $ map read $ words line
    putStrLn $ unwords $ map (show . (last arr -)) $ init arr

import Text.Printf
import Data.List

main = do
  n <- fmap (map read . words) getLine :: IO [Int]
  let l = sort n
  printf "%d %d %d" (l!!3 - l!!0) (l!!3 - l!!1) (l!!3 - l!!2)

merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) = (m : merge xs' ys')
  where
    m = min x y
    (xs',ys') = if x>y then (x:xs,ys) else (xs,y:ys)

mergesort :: Ord a => [a] -> [a]
mergesort (x:[]) = [x]
mergesort xs = merge (mergesort ys) (mergesort zs)
  where
    (ys,zs) = (take (n `quot` 2) xs, drop (n `quot` 2) xs)
    n = length xs

getInts :: IO [Int]
getInts  = do
  s <- getLine
  let iss = words s
  let is = map (\x -> read x :: Int) iss
  return is

f :: [Int] -> [Int]
f xs = [m-a,m-b,m-c]
  where
    [a,b,c,m] = mergesort xs

showI :: [Int] -> String
showI (x:[]) = show x
showI (x:xs) = show x ++ " " ++ showI xs

main :: IO ()
main = do
  ss <- getInts
  putStr.showI.f $ ss
  putStr "\n"

import Data.List
main :: IO ()
main = do
    inpu <- getLine
    let ns = map read (words inpu)
    putStrLn $ concat $ intersperse " " ( map show (solve ns))
    return ()
solve :: [Int] -> [Int]
solve xs = delete 0 (map f xs)
           where f x =(maximum xs)-x

{-# LANGUAGE BlockArguments #-}

import Control.Arrow
import Data.List

main = do { x <- getLine; putStrLn $ (words >>> map read >>> solve >>> map show >>> unwords) x }

solve :: [Integer] -> [Integer]
solve x = let y = sort x in map (\z -> (last y) - z) (init y)

main = getLine >>= putStrLn . answer . solve . map read . words

answer [] = []
answer (x:xs) = show x ++ " " ++ answer xs

solve xs = filter (/=0) $ map (`subtract` (sum xs `div` 3)) xs

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

solve :: [Int] -> [Int]
solve xs = map (uncurry (-)) $ zip (replicate 3 (last ys)) ys
    where ys = sort xs

main :: IO ()
main = do
    xs <- readInts
    putStrLn $ unwords $ map show $ solve xs

import Data.List
main :: IO ()
main = do
    inpu <- getLine
    let ns = map read (words inpu)
    putStrLn $ intersperse ' ' (concat $ map show (solve ns))
    return ()
solve :: [Int] -> [Int]
solve xs = delete 0 (map f xs)
           where f x =(maximum xs)-x

import Data.List
main :: IO ()
main = do
    inpu <- getLine
    let ns = map read (words inpu)
    putStrLn $ intersperse ' ' (concat $ map show (solve ns))
    return ()
solve :: [Int] -> [Int]
solve xs = delete 0 (map f xs)
           where f x =x-(maximum xs)

main =
    getLine >>= \line ->
    let nums = map read $ (words line) :: [Int] in
    let sum_vals = foldl max 0 nums in
    let vals = [sum_vals - x | x <- nums, x /= sum_vals] in
    print $ unwords $ map show vals

import Data.List
f a = map (\x -> x - minimum a) a
main = interact $ show . delete 0 . f . map read . words

import Data.List
f a = map (\x -> x - minimum a) a
main = interact $ unwords . map show . delete 0 . f . map read . words


import Control.Applicative

main = do
  _ <- getLine
  a <- map read <$> (words <$> getLine)
  let
    b = a ++ [0]
    c = [0] ++ a
    d = zipWith max b c
  print $ minimum d

module Main where

main = do
    _ <- getLine
    s <- getLine
    let l = (map read (words s)) :: [Int]
    let n = length l
    print(minimum ([max (l !! i) (l !! (i+1)) | i <- [0 .. n-2]] ++ [head l] ++ [last l]))

solve :: [Int] -> Int
solve xs  =  minimum $ [head xs, last xs] ++ pairs
  where
    pairs  =  zipWith max xs (tail xs)

main :: IO ()
main  =  getLine >> getLine >>= return . map read . words >>= print . solve

solve :: Int -> [Int] -> Int
solve n xs | head isNotDestroyed && last isNotDestroyed && longestChain False isNotDestroyed <= 1 = solve (n+1) xs
           | otherwise = n
    where isNotDestroyed = map (>n) xs
longestChain :: (Eq a) => a -> [a] -> Int
longestChain _ [] = 0
longestChain el l@(_:xs) | null a = longestChain el xs
                         | otherwise = max (length a) (longestChain el b)
    where (a, b) = span (==el) l
main = getLine >> fmap (map read . words) getLine >>= print . solve 1

import Data.List
import Data.Ord
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS

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

solve :: Int -> [Int] -> Int
solve n xs = go (IS.fromList [0,n+1]). sortBy (comparing snd) $ zip [1..] xs
   where
     go set ((i,y):ys)
       | any (`IS.member`set) [i-1,i+1] = y
       | otherwise = go (IS.insert i set) ys

module Main where

main = do
    _ <- getLine
    s <- getLine
    let l = (map read (words s)) :: [Int]
    let n = length l
    print(minimum [max (l !! i) (l !! (i+1)) | i <- [0 .. n-2]])

import Data.List
import Data.Ord
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS

main = getLine >> getLine >>= print.solve.map read.words

solve :: [Int] -> Int
solve [x] = x
solve xs = go IS.empty . sortBy (comparing snd) $ zip [1..] xs
   where
     go set ((i,y):ys)
       | any (`IS.member`set) [i-1,i+1] = y
       | otherwise = go (IS.insert i set) ys


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

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

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

main = do
  [n, m] <- getInts
  ws <- getInts
  bs <- getInts

  let
    a = reverse $ foldl (\a b -> if b `elem` a then a else b:a) [] bs

    f _ [] = 0
    f a (b:bs) = c + f a' bs
      where
        c = sum $ map (\i -> ws!!(i-1)) $ takeWhile (/= b) $ a
        a' = b:(a \\ [b])

  print $ f a bs

{-# 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 ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    ws <- readInts
    bs <- readInts
    print $ solve n m ws bs

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve n m ws bs = calc cs bs where
    cs = go S.empty bs
    go s [] = []
    go s (x:xs) | S.member x s = go s xs
                | otherwise = x:go (S.insert x s) xs
    weight :: UArray Int Int
    weight = listArray (1,n) ws
    calc st [] = 0
    calc st (x:xs) = w + calc st' xs where
        Just i = elemIndex x st
        w = sum $ map (weight !) $ take i st
        st' = x:take i st ++ drop (i+1) st


import Control.Applicative ((<$>))
import Data.Bits ((.&.))
import Data.Int (Int64)

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Int64
      mod' x = mod x m'
      mpow x p = go (mod' x) 1 1
        where go _ q acc | q > p = acc
              go y q acc = go (mod' $ y*y) (q*2) $ if q .&. p == 0 then acc else mod' (y*acc)

      ainv = mpow a (m' - 2)
      (a1, _) = foldl (\(acc, ab) s -> (mod' (acc + mod' (s*ab)), mod' (mod' (ab*b)*ainv)))
                      (0, mpow a n) ss
      r = mod' (mpow b k * mpow (mpow a k) (m' - 2))
      nk = div (n + 1) k
      gs = if r == 1
           then mod' (a1 * nk)
           else mod' (mod' (a1 * (1 - mpow r nk)) * mpow (1 - r) (m' - 2))

  print gs

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k-1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Integer
      m x = rem (x + m') m'
      r = div (b^k) (a^k)
      a1 = foldl (\(acc, (ai, bi)) i ->
                   let acc' = acc + (ss ! i) * ai * bi
                   in  (acc', (div ai a, bi*b)))
                  (0, (a^n, 1)) [0..k-1]

  print . m $
    if a == b
    then fst a1 * div (n + 1) k
    else fst a1 * div (1 - r^(div (n + 1) k)) (1-r)

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (fromInteger b/fromInteger a)^k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai `div` a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then mod' a1 * ((n+1) `div` k)
    else round $ fromInteger (mod' a1) * (1 - r^((n+1) `div` k)) / (1-r)

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (fromIntegral b/fromIntegral a) ^ k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (mod' acc', (div ai a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' . (* a1) $
    if a == b
    then div (n + 1) k
    else round ((1 - r^(div (n+1) k)) / (1-r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (fromInteger b/fromInteger a)^k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (mod' (acc + s*ai*bi), (ai `div` a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then a1 * ((n+1) `div` k)
    else round $ fromInteger a1 * (1 - r^((n+1) `div` k)) / (1-r)

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (fromIntegral b/fromIntegral a) ^ k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (mod' acc', (div ai a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then a1 * div (n + 1) k
    else round (fromIntegral a1 * (1 - r^(div (n+1) k)) / (1-r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Int)
      r = (b/a)**k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai/a, bi*b)))
                       (0, (a**n, 1)) ss

  print . mod' . round $
    if a == b
    then a1 * (n+1) / k
    else a1 * (1 - r**((n+1) / k)) / (1-r)

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Int
      r = fromIntegral (mpow b k m') / fromIntegral (mpow a k m')
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (mod acc' m', (div ai a, mod (bi*b) m')))
                       (0, (mpow a n m', 1)) ss

  print . flip mod m' . (* a1) $
    if a == b
    then div (n + 1) k
    else round ((1 - r^(div (n+1) k)) / (1-r))

mpow :: Int -> Int -> Int -> Int
mpow x p m = go p 1
  where go 0 acc = acc
        go p acc = go (p - 1) $ mod (x * acc) m

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (fromIntegral b/fromIntegral a) ^ k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (acc', (div ai a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then a1 * div (n + 1) k
    else round (fromIntegral a1 * (1 - r^(div (n+1) k)) / (1-r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (b/a)**k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai/a, bi*b)))
                       (0, (a**n, 1)) ss

  print . mod' . round $
    if a == b
    then a1 * (n+1) / k
    else a1 * (1 - r**((n+1) / k)) / (1-r)

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Int)
      r = (fromIntegral b/fromIntegral a) ^ k :: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (mod' acc', (div ai a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then a1 * div (n + 1) k
    else round (fromIntegral a1 * (1 - r^(div (n+1) k)) / (1-r))

import Control.Applicative ((<$>))
import Data.Bits ((.&.))
import Data.Int (Int64)

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Int64
      mod' x = mod x m'
      mpow x p = go (mod' x) 1 1
        where go _ q acc | q > p = acc
              go y q acc = go (mod' $ y*y) (q*2) $ if q .&. p == 0 then acc else mod' (y*acc)

      ainv = mpow a (m' - 2)
      (a1, _, _) = foldl (\(acc, ai, bi) s -> (acc + mod' (s*ai*bi), mod' (ai*ainv), mod' (b*bi)))
                         (0, mpow a n, 1) ss
      r = mod' (mpow b k * mpow (mpow a k) (m' - 2))
      nk = div (n + 1) k
      gs = if r == 1
           then mod' (a1 * nk)
           else mod' (mod' (a1 * (1 - mpow r nk)) * mpow (1 - r) (m' - 2))

  print gs

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = fromInteger (b^k)/fromInteger (a^k)
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai `div` a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then a1 * ((n+1) `div` k)
    else round $ fromInteger a1 * (1 - r^((n+1) `div` k)) / (1-r)

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k-1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Integer
      m x = rem (m' + rem x m') m'
      r = div (b^k) (a^k)
      a1 = foldl (\(acc, (ai, bi)) i ->
                   let acc' = acc + (ss ! i) * ai * bi
                   in  (m acc', (div ai a, bi*b)))
                  (0, (a^n, 1)) [0..k-1]

  print . m $
    if a == b
    then fst a1 * div (n + 1) k
    else fst a1 * div (1 - r^(div (n + 1) k)) (1-r)

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k-1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9
      m x = rem (m' + rem x m') m'
      r = div (b^k) (a^k)
      a1 = foldl (\(acc, (ai, bi)) i ->
                   let acc' = acc + (ss ! i) * ai * bi
                   in  (m acc', (div ai a, bi*b)))
                  (0, (a^n, 1)) [0..k-1]

  print . m $
    if a == b
    then fst a1 * div n k
    else fst a1 * div (1 - r^(div n k + 1)) (1-r)

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k - 1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 1000000009
      m x = rem x m'
      loop from to (acc, _) | from > to = acc
      loop from to (acc, (ai, bi)) = loop (from + 1) to (acc', (div ai a, bi * b))
        where s = ss ! from
              acc' = m (m (acc + s*ai*bi) + m')
      a1 = loop 0 (k-1) (0, (a^n, 1))
      r = div (b^k) (a^k)

  print . m $ m' +
    if a == b
    then m (a1 * div n k)
    else  m (a1 * div (1 - r^(div n k + 1)) (1 - r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = fromInteger (mod' $ b^k) / fromInteger (mod' $ a^k)
      a1 = fst $ foldl (\(acc, (ai, bi)) s ->
                         let acc' = acc + s*ai*bi
                         in  (mod' acc', (div ai a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' . (* a1) $
    if a == b
    then div (n + 1) k
    else round ((1 - r^(div (n+1) k)) / (1-r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = (b**k/a**k):: Double
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai/a, bi*b)))
                       (0, (a**n, 1)) ss

  print . mod' . round $
    if a == b
    then a1 * (n+1) / k
    else a1 * (1 - r**((n+1) / k)) / (1-r)

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k - 1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 1000000009 :: Integer
      m x = rem x m'
      loop from to (acc, _) | from > to = acc
      loop from to (acc, (ai, bi)) = loop (from + 1) to (acc', (div ai a, bi * b))
        where s = ss ! from
              acc' = m (m (acc + s*ai*bi) + m')
      a1 = loop 0 (k-1) (0, (a^n, 1))
      r = div (b^k) (a^k)

  print . m $
    m' + m (a1 * if a == b
                 then div n k
                 else div (1 - r^(div n k + 1)) (1 - r))

import Control.Applicative ((<$>))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let mod' x = mod x (10^9 + 9 :: Integer)
      r = fromInteger (b^k)/fromInteger (a^k)
      a1 = fst $ foldl (\(acc, (ai, bi)) s -> (acc + s*ai*bi, (ai `div` a, bi*b)))
                       (0, (a^n, 1)) ss

  print . mod' $
    if a == b
    then mod' a1 * ((n+1) `div` k)
    else round $ fromInteger (mod' a1) * (1 - r^((n+1) `div` k)) / (1-r)

import Control.Applicative ((<$>))
import Data.Array (listArray, (!))

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- listArray (0, k - 1) . map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 1000000009 :: Integer
      m x = rem x m'
      a1 = fst $ foldl (\(acc, (ai, bi)) i ->
                         (m (m' + m (acc + (ss ! i)*ai*bi)), (div ai a, bi*b)))
                       (0, (a^n, 1)) [0..k-1]
      r = div (b^k) (a^k)

  print . m $
    m' + m (a1 * if a == b
                 then div n k
                 else div (1 - r^(div n k + 1)) (1 - r))

import Control.Applicative ((<$>))
import Data.Bits ((.&.))
import Data.Int (Int64)

main = do
  [n, a, b, k] <- map read . words <$> getLine
  ss <- map (\x -> if x == '+' then 1 else -1) <$> getLine

  let m' = 10^9 + 9 :: Int64
      mod' x = mod x m'
      mpow x p = go (mod' x) 1 1
        where go _ q acc | q > p = acc
              go y q acc = go (mod' $ y*y) (q*2) $ if q .&. p == 0 then acc else mod' (y*acc)

      ainv = mpow a (m' - 2)
      (a1, _, _) = foldl (\(acc, ai, bi) s -> (acc + mod' (s*ai*bi), mod' (ai*ainv), mod' (b*bi)))
                         (0, mpow a n, 1) ss
      r = mod' (mpow b k * mpow (mpow a k) (m' - 2))
      nk = div (n + 1) k
      gs = if a == b
           then mod' (a1 * nk)
           else mod' (mod' (a1 * (1 - mpow r nk)) * mpow (1 - r) (m' - 2))

  print gs


module Main where

import Data.List (sort, reverse)

getAnswer :: [Int] -> [Int] -> Int
getAnswer (lt : rt : []) _ = 0
getAnswer (lt : lmid : ls) (rt : rmid : rs) = min (rmid - lt) (rt - lmid)

main :: IO ()
main = do
    nStr <- getLine
    let n = read nStr :: Int
    lStr <- getLine
    let l = sort $ map read (words lStr) :: [Int]
    print $ getAnswer l (reverse l)

module Main where
import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Array

main = do
    C.getLine
    as <- map ((read :: String -> Int ). C.unpack ) . C.words <$> C.getLine
    let ass = group $ sort as
        bs = array (1,length ass) $ zip [1..] ass
        r = if head (bs!1) == head (bs!length bs) then 0
             else if length (bs!1) == 1 && length (bs!length bs) == 1 then  min (head (bs!(length bs-1)) - head (bs!1)) (head (bs!length bs) - head (bs!2))
            else if length (bs!1) == 1 && length (bs!length bs) /= 1 then  head (bs!length bs) - head (bs!2)
            else if length (bs!1) /= 1 && length (bs!length bs) == 1 then  head (bs!(length bs-1)) - head (bs!1)
            else head (bs!length bs) - head (bs!1)
    print r

import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = min (c-a) (d-b) where
  s@(a:b:_) = sort as
  [c,d] = drop (n-2) s

import Data.List

main = do
    getLine
    a <- fmap (sort . map read . words) getLine
    print . minimum . map (\x -> last x - head x) $ [init a, tail a]

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

ins m1 = last m1 - head m1

main = do
		n<-read <$> getLine ::IO Int
		m<-sort <$> map read <$> words <$> getLine ::IO [Int]
		let m1 = init m
		let m2 = tail m
		print $ min (ins m1) (ins m2)

module Main where

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

instability :: [Int] -> Int
instability xs = hi - lo
    where hi = maximum xs
          lo = minimum xs

solve :: [Int] -> Int
solve xs = min (instability $ delete hi xs) (instability $ delete lo xs)
    where hi = maximum xs
          lo = minimum xs

tests :: [[Int]]
tests = [[1, 3, 3, 7], [1, 100000]]

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                               Just (x, _) -> (x, ss)
                               Nothing -> error $ "Can't parse Int from: " ++ (L.unpack s)
go :: Tokenizer Int
go = do
  n <- nextInt
  xs <- replicateM n nextInt
  return $ solve xs

main :: IO ()
main = do
  input <- L.words <$> L.getContents
  let output = evalState go input
  print output

import Data.List

main = do
    s <- getLine
    s <- getLine
    let a = sort (map read (words s)) :: [Int]
    print (min (last a - head (tail a)) (last (init a) - head a))

import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = min (c-a) (d-b) where
  s@(a:b:_) = sort as
  [c,d] = drop (n-2) as

import Data.List
main = interact $ solve . map read . words
solve (n:as) | n < 100 = show $ min (c-a) (d-b)
             | otherwise = show [a,b,c,d,length as]
 where
  s@(a:b:_) = sort as
  [c,d] = drop (n-2) as


import Data.List

f ::[Int]->Int
f xs=let ys=group xs
         (a:b:[])=map length ys
     in if a<=b then a else b+(a-b) `div` 3

main = do
       e<-getLine
       es<-getLine
       let c=read e::Int
           xs=map read (words es)::[Int]
           ys=sort xs
           a=head ys
           b=last ys
       print $ if a==2 then 0 else if b==1 then c `div` 3 else f ys

module Main where

import Control.Applicative
import Control.Monad

solve :: [Int] -> Int
solve xs = a + b
    where nones = length $ filter (== 1) xs
          ntwos = length xs - nones

          a = min nones ntwos
          b = (nones - a) `div` 3

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

import Data.List
import qualified Data.ByteString.Char8 as B
main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve = (\gs -> case gs of { [os, ts] -> let lo = length os; lt = length ts in if lo > lt then lt + (lo - lt) `quot` 3 else lo; [os@(1:_)] -> (length os) `quot` 3; _ -> 0}) . group . sort

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

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine
  where parse s = let Just (n, _) = C.readInt s in n

count = foldr (\x (_1s,_2s) -> if x == 1 then (_1s+1,_2s) else (_1s,_2s+1)) (0,0)

main = do
   getLine
   as <- readChar8
   let (a',b') = count as
       r = case (a',b') of
                (a,b) | a==b || b>a -> a
                (a,b) | a>b  -> b + (a-b)`div`3
   print r

import Control.Applicative
import Control.Monad

main = sol <$> (getLine *> get) >>= print

get = fmap read . words <$> getLine

--sol :: [Int] -> Int
sol as = p + q
    where
    a1 = length $ filter (==1) as
    a2 = length $ filter (==2) as
    p = min a1 a2
    q = if a1 > a2 then (a1 - a2) `div` 3 else 0

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

main = do
		n<- read<$> getLine ::IO Int
		a<- map read <$> words <$>  getLine::IO [Int]
		let o = length $ filter (==1) a
		let t = length $ filter (==2) a
		let ans = (min o t)
		print $ ans + (div  (o-ans) 3)

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms, CPP,
             TupleSections, UnicodeSyntax, LambdaCase,
             MultiWayIf #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . tail . lines

sol :: [[Int]] -> [String]
sol [as] = let
    (j',d') = partition (==1) as
    (j,d) = (length j', length d')
    x = min j d
    x' = (j - x) `div` 3
  in [ show $ (x+x') ]

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

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

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------


import Data.List.Split
main = do
    n <- readLn::IO Int
    str <- getLine
    let (hd:tl) = split (onSublist "><") str
	pre = length $ takeWhile ('<'==) hd
	post = length $ takeWhile ('>'==) . reverse $ last tl
    print $ case hd:tl of
	    [a]	->  length a
	    otherwise ->pre+post

main=interact$show.f.(!!1).lines
f cs = g cs + h cs
g cs = length $ takeWhile (=='<') cs
h cs = length . takeWhile (=='>') $ reverse cs

import Data.List

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

removeMaybe :: Int -> Maybe Int -> Int
removeMaybe _ (Just a) = a
removeMaybe n Nothing  = n

solve :: String -> Int
solve s = let n = length s
              l = removeMaybe n $ findIndex (== '>') s
              r = removeMaybe n $ findIndex (== '<') $ reverse s
          in l + r

main = do
	getLine
	x <- getLine
	print $ (length $ takeWhile (== '<') x) + (length $ takeWhile (== '>') $ reverse x)

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

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

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

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

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

  check :: Int -> Int -> Int -> (Int, Bool)
  check k r n =
    let result = (k * n) `mod` 10 == r
        in (n, result)

  solve :: Int -> Int -> [Int]
  solve k r = map fst $ filter snd $ map (check k r) [1..10]

  h :: [Int] -> Int
  h [] = 10
  h (x:xs) = x

  solvex :: Int -> Int
  solvex 5 = 2
  solvex 2 = 5
  solvex 4 = 5
  solvex 6 = 5
  solvex 0 = 1
  solvex 8 = 5
  solvex _ = 10

  r1 :: String -> Int -> Int
  r1 ('<':xs) a = r1 xs (a+1)
  r1 ('>':xs) a = a
  r1 [] a = a

  r2 :: String -> Int -> Int
  r2 ('>':xs) a = r2 xs (a+1)
  r2 ('<':xs) a = a
  r2 [] a = a

  main :: IO()
  main = do
    n <- getLine
    xs <- getLine
    print $ (r1 xs 0) + (r2 (reverse xs) 0)

import qualified Data.List as L
main = return ()

import Control.Monad.Trans.State.Lazy
main = do
    n <- readLn::IO Int
    str <- getLine
    let process [] = return 0
	process [b] = return 1
	process (b1:b2:bs)
	  | [b1,b2] == "><" =
		return.length.takeWhile ('>'==)$reverse bs
	  | otherwise	    = modify (b1:) >> process (b2:bs)
    (v,st) <- runStateT (process str) []
    print $ (length $ dropWhile ('>'==) st) + v


{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, insert, alter, empty, (!), (!?), fromList)
import Data.List (unfoldr)

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO Value
getPair = do
  [a, b] <- readChar8
  return (a, b)

buildTree :: Map Int Value -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go n = let value = xs ! n in maybe (Leaf value) (Node value) $ fmap go <$> m !? n

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) = alter (maybe (Just [n]) (Just . (n :))) x $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (_, y)) = (y, 1)
dfs (Node (l, h) xs) = if l > childSum
    then (h, number + 1)
    else (min childSum h, number)
  where
    (childSum, number) = foldl1 addUp $ dfs <$> xs

parse :: IO Domain
parse = do
  [nodeCount] <- readChar8
  parents <- readChar8
  ranges <- fromList . zipWith (,) [1..] <$> replicateM nodeCount getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n (printAns <$> solve =<< parse)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, insert, alter, empty, (!), (!?), fromList)
import qualified Data.Char as C
import Data.List (unfoldr)

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = parse <$> C.getLine
  where parse = unfoldr go
        go s = do (n, s1) <- C.readInt s
                  let s2 = C.dropWhile C.isSpace s1
                  return (n, s2)

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns = print

getPair :: IO Value
getPair = do
  [a, b] <- readChar8
  return (a, b)

buildTree :: Map Int Value -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go n = let value = xs ! n in maybe (Leaf value) (Node value) $ fmap go <$> m !? n

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) = alter (maybe (Just [n]) (Just . (n :))) x $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (_, y)) = (y, 1)
dfs (Node (l, h) xs) = if l > childSum
    then (h, number + 1)
    else (min childSum h, number)
  where
    (childSum, number) = foldl1 addUp $ dfs <$> xs

parse :: IO Domain
parse = do
  [nodeCount] <- readChar8
  parents <- readChar8
  ranges <- fromList . zipWith (,) [1..] <$> replicateM nodeCount getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n (printAns <$> solve =<< parse)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Bits
-- import Debug.Trace
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import Data.String ( IsString(fromString) )
import qualified Data.ByteString.Char8 as C
import Data.List (dropWhileEnd)
import Data.Map (Map, insert, alter, empty, (!), (!?))

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

parseInt :: String -> Int
parseInt = fromIntegral . fst . fromJust . C.readInt . fromString

parseIntList :: String -> [Int]
parseIntList = map parseInt . words

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns x = print x

getPair :: IO Value
getPair = do
  [a, b] <- fmap parseInt . words <$> getLine
  return (a, b)

buildTree :: [Value] -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go :: Int -> Tree
    go n = maybe (Leaf value) (Node value) $ fmap go <$> m !? n
      where
        value = xs !! (n-1)

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) = alter (maybe (Just [n]) (Just . (n :))) x $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (_, y)) = (y, 1)
dfs (Node (l, h) xs) = if l > childSum then (h, number + 1) else (childSum, number)
  where
    (childSum, number) = foldl1 addUp $ dfs <$> xs

parse :: IO Domain
parse = do
  nodeCount <- parseInt <$> getLine
  parents <- parseIntList <$> getLine
  ranges <- replicateM (fromIntegral nodeCount) getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  n <- parseInt <$> getLine
  replicateM_ (fromIntegral n) (printAns <$> solve =<< parse)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Bits
-- import Debug.Trace
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import Data.String ( IsString(fromString) )
import qualified Data.ByteString.Char8 as C
import Data.List (dropWhileEnd)
import Data.Map (Map, insert, alter, empty, (!), (!?))

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

parseInt :: String -> Int
parseInt = fromIntegral . fst . fromJust . C.readInt . fromString

parseIntList :: String -> [Int]
parseIntList = map parseInt . words

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns x = print x

getPair :: IO Value
getPair = do
  [a, b] <- fmap parseInt . words <$> getLine
  return (a, b)

buildTree :: [Value] -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go :: Int -> Tree
    go n = maybe (Leaf value) (Node value) $ fmap go <$> m !? n
      where
        value = xs !! (n-1)

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) = alter (maybe (Just [n]) (Just . (n :))) x $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (_, y)) = (y, 1)
dfs (Node (l, h) xs) = (h, number + if l > childSum then 1 else 0)
  where
    (childSum, number) = foldl1 addUp $ dfs <$> xs

parse :: IO Domain
parse = do
  nodeCount <- parseInt <$> getLine
  parents <- parseIntList <$> getLine
  ranges <- replicateM (fromIntegral nodeCount) getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  n <- parseInt <$> getLine
  replicateM_ (fromIntegral n) (printAns <$> solve =<< parse)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Bits
-- import Debug.Trace
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String ( IsString(fromString) )
import qualified Data.ByteString.Char8 as C
import Data.List (dropWhileEnd)
import Data.Map (Map, insert, alter, empty, (!), (!?))

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

parseInt :: String -> Int
parseInt = fromIntegral . fst . fromJust . C.readInt . fromString

parseIntList :: String -> [Int]
parseIntList = map parseInt . words

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns x = print x

getPair :: IO Value
getPair = do
  [a, b] <- fmap parseInt . words <$> getLine
  return (a, b)

buildTree :: [Value] -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go :: Int -> Tree
    go n = case children of
      Just x -> Node value x
      Nothing -> Leaf value
      where
        children = fmap go <$> m !? n
        value = xs !! (n-1)

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) =
  alter
    ( \case
        Nothing -> Just [n]
        Just ys -> Just (n : ys)
    )
    x
    $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (_, y)) = (y, 1)
dfs (Node (l, h) xs) = (h, number + if l > childSum then 1 else 0)
  where
    (childSum, number) = foldl1 addUp $ dfs <$> xs

parse :: IO Domain
parse = do
  nodeCount <- parseInt <$> getLine
  parents <- parseIntList <$> getLine
  ranges <- replicateM (fromIntegral nodeCount) getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  n <- parseInt <$> getLine
  replicateM_ (fromIntegral n) (printAns <$> solve =<< parse)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM)
import Data.Bits
-- import Debug.Trace
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String ( IsString(fromString) )
import qualified Data.ByteString.Char8 as C
import Data.List (dropWhileEnd)
import Data.Map (Map, insert, alter, empty, (!), (!?))

type Value = (Int, Int)
data Tree = Leaf Value | Node Value [Tree] deriving (Show)
type Domain = Tree
type CoDomain = Int
type Solver  = Domain -> CoDomain

parseInt :: String -> Int
parseInt = fromIntegral . fst . fromJust . C.readInt . fromString

parseIntList :: String -> [Int]
parseIntList = map parseInt . words

solve :: Solver
solve xs = snd $ dfs xs

printAns :: CoDomain -> IO ()
printAns x = print x

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

getPair :: IO Value
getPair = do
  [a, b] <- fmap parseInt . words <$> getLine
  return (a, b)

buildTree :: [Value] -> Map Int [Int] -> Tree
buildTree xs m = go 1
  where
    go :: Int -> Tree
    go n = case children of
      Just x -> Node value x
      Nothing -> Leaf value
      where
        children = fmap go <$> m !? n
        value = xs !! (n-1)

parentToChildren :: Int -> [Int] -> Map Int [Int]
parentToChildren _ [] = empty
parentToChildren n (x : xs) =
  alter
    ( \case
        Nothing -> Just [n]
        Just ys -> Just (n : ys)
    )
    x
    $ parentToChildren (n + 1) xs

addUp :: (Int, Int) -> (Int, Int) -> (Int, Int)
addUp (x1, x2) (y1, y2) = (x1 + y1, x2 + y2)

dfs :: Tree -> (Int, Int)
dfs (Leaf (x, y)) = (y, 1)
dfs (Node (l, h) xs) = (h, number + if l > childSum then 1 else 0)
  where
    (childSum, number) = foldl1 addUp $ map dfs xs

parse :: IO Domain
parse = do
  nodeCount <- getInt
  parents <- parseIntList <$> getLine
  ranges <- replicateM (fromIntegral nodeCount) getPair
  return $ (buildTree ranges $ parentToChildren 2 parents)

main :: IO ()
main = do
  n <- parseInt <$> getLine
  replicateM_ (fromIntegral n) (printAns <$> solve =<< parse)


{-# LANGUAGE BangPatterns #-}
import Data.Int (Int64)
import Data.List (sort)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, listArray, (!), amap)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int64 -> Int64 -> [(Int64, Int64)] -> Int64
solve h w a = snd . head . foldr loop [] $ (1, 1) :(sort a)
    where
    !m = 1000000007 :: Int64

    (*:) !i !j = (i * j) `mod` m
    (+:) !i !j = (i + j) `mod` m
    (-:) !i !j = (`mod` m) . (+ m) . (`mod` m) $ i - j

    fac :: UArray Int64 Int64
    !fac = listArray (0, h + w) $ scanl (*:) 1 [1..h + w]

    ifac :: UArray Int64 Int64
    !ifac = amap inverse fac
        where inverse !a = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

    count (!i, !j) (!i', !j')
        | i' < i || j' < j = 0
        | otherwise = (fac ! (di + dj)) *: (ifac ! di) *: (ifac ! dj)
        where
        !di = i' - i
        !dj = j' - j

    loop self@(!i, !j) !acc = ((i, j), out):acc
        where
        !out = count self (h, w) -: foldr (+:) 0 (count' <$> acc)
        count' ((!i', !j'), !k) = k *: count self (i', j')

wrap :: Int -> Int -> [[Int64]] -> Int64
wrap h w a = solve (fromIntegral h) (fromIntegral w) a'
    where a' = (\[i, j] -> (i, j)) <$> a

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

main = do
    [h, w, n] <- parse <$> B.getLine
    a <- replicateM n (parse <$> B.getLine)
    print $ wrap h w a

module Main(main) where

import Control.Monad(replicateM)
import Data.Functor
import Data.List
import Data.Array

isDigit x = x>='0' && x<='9'
split f l@(a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Integer]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs

factorials = go 0 1 where
	go 200001 _ = []
	go i j = (i,j):(go (i+1) ((j*(i+1)) `rem` p))

p::Integer
p = 1000000007
(<**>) x y = (x * y) `rem` p
(<+>) x y = let t = x + y in if t < p then t else t-p
(<->) x y = let t = x - y in if t < 0 then t+p else t
pow x 0 = 1
pow x a = let ll = pow (x<**>x) (a `quot` 2) in if a `rem` 2 > 0 then (ll <**> x) else ll
inverse x = pow x (p-2)
facs = array (0, 200000) factorials
ifacs = array (0, 200000) $ map (\(x,y) -> (x, inverse y)) factorials
choose a b
	| 0<=b && 0<=a = (facs ! (a+b)) <**> (ifacs ! a) <**> (ifacs ! b)
	| otherwise = 0

dp (prev) me@((i, j)) =
	let
		fn (d, (a, b)) = d <**> (choose (i-a) (j-b))
	in
		((choose (i-1) (j-1)) <-> (foldl (<+>) 0 $ map fn prev), me):prev
runDp :: [(Integer, Integer)] -> [Integer]
runDp l = let t = foldl dp ([]) l in map fst t
--runDp (a:as) = let

main = do
	l <- getLine
	let [h, w, n] = readInts l
	let srt = sortBy (\x y -> compare (sum x) (sum y))
	blacks <- ((map (\x->(head x, x!!1))).srt) <$> replicateM (fromInteger n) (readInts <$> getLine)
	let all = blacks ++ [(h, w)]
	putStrLn $ show $ head.runDp $ all

{-# LANGUAGE BangPatterns #-}
import Data.Int (Int64)
import Data.List (sort)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, listArray, (!), amap)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int64 -> Int64 -> [(Int64, Int64)] -> Int64
solve h w a = snd . head . foldr loop [] $ (1, 1) :(sort a)
    where
    !m = 1000000007 :: Int64

    (*:) !i !j = (i * j) `mod` m
    (+:) !i !j = (i + j) `mod` m
    (-:) !i !j = (`mod` m) . (+ m) . (`mod` m) $ i - j

    fac :: UArray Int64 Int64
    !fac = listArray (0, h + w) $ scanl (*:) 1 [1..h + w]

    ifac :: UArray Int64 Int64
    !ifac = amap inverse fac
        where inverse !a = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

    count (!i, !j) (!i', !j')
        | i' < i || j' < j = 0
        | otherwise = (fac ! (di + dj)) *: (ifac ! di) *: (ifac ! dj)
        where
        !di = i' - i
        !dj = j' - j

    loop self@(!i, !j) !acc = ((i, j), out):acc
        where
        out = count self (h, w) -: foldr (+:) 0 (count' <$> acc)
        count' ((i', j'), k) = k *: count self (i', j')

wrap :: Int -> Int -> [[Int64]] -> Int64
wrap h w a = solve (fromIntegral h) (fromIntegral w) a'
    where a' = (\[i, j] -> (i, j)) <$> a

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

main = do
    [h, w, n] <- parse <$> B.getLine
    a <- replicateM n (parse <$> B.getLine)
    print $ wrap h w a

{-# LANGUAGE BangPatterns #-}
import Data.Int (Int64)
import Data.List (sort)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, listArray, (!), amap)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int -> Int -> [(Int, Int)] -> Int64
solve h w a = snd . head . foldr loop [] $ (1, 1) :(sort a)
    where
    !m = 1000000007 :: Int64

    (*:) !i !j = (i * j) `mod` m
    (+:) !i !j = (i + j) `mod` m
    (-:) !i !j = (`mod` m) . (+ m) . (`mod` m) $ i - j

    fac :: UArray Int Int64
    !fac = listArray (0, h + w) $ scanl (*:) 1 [1.. fromIntegral $ h + w]

    ifac :: UArray Int Int64
    !ifac = amap inverse fac
        where inverse !a = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

    count (!i, !j) (!i', !j')
        | i' < i || j' < j = 0
        | otherwise = (fac ! (di + dj)) *: (ifac ! di) *: (ifac ! dj)
        where
        !di = i' - i
        !dj = j' - j

    loop self@(!i, !j) !acc = ((i, j), out):acc
        where
        !out = count self (h, w) -: foldr (+:) 0 (count' <$> acc)
        count' ((!i', !j'), !k) = k *: count self (i', j')

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

main = do
    [h, w, n] <- parse <$> B.getLine
    a <- replicateM n ((\[i, j] -> (i, j)) . parse <$> B.getLine)
    print $ solve h w a

{-# LANGUAGE BangPatterns #-}
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, listArray, (!), amap)

gcd' :: Integral a => a -> a -> (a, a)
gcd' !a !b
    | a `mod` b /= 0 = loop 1 0 0 1 a b
    | otherwise = (0, 1)
    where
    loop !x !y !x' !y' !r !r'
        | r' `mod` r'' == 0 = (x - q * x', y - q * y')
        | otherwise = loop x' y' (x - q * x') (y - q * y') r' r''
        where (q, r'') = r `divMod` r'

solve :: Int64 -> Int64 -> [(Int64, Int64)] -> Int64
solve h w = snd . head . foldr loop [] . ((1, 1):)
    where
    !m = 1000000007 :: Int64
    (*:) !i !j = (i * j) `mod` m
    (+:) !i !j = (i + j) `mod` m
    (-:) !i !j = ((i - j) `mod` m + m) `mod` m

    fac :: UArray Int64 Int64
    !fac = listArray (0, h + w) $ scanl (*:) 1 [1..h + w]

    ifac :: UArray Int64 Int64
    !ifac = amap inverse fac
        where inverse !a = (`mod` m) . (+ m) . (`mod` m) . fst $ gcd' a m

    count (!i, !j) (!i', !j')
        | i' < i || j' < j = 0
        | otherwise = (fac ! (di + dj)) *: (ifac ! di) *: (ifac ! dj)
        where
        !di = i' - i
        !dj = j' - j

    loop self@(!i, !j) !acc = ((i, j), out):acc
        where
        out = count self (h, w) -: foldr (+:) 0 (count' <$> acc)
        count' ((i', j'), k) = k *: count self (i', j')

wrap :: Int -> Int -> [[Int64]] -> Int64
wrap h w a = solve (fromIntegral h) (fromIntegral w) a'
    where a' = (\[i, j] -> (i, j)) <$> a

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

main = do
    [h, w, n] <- parse <$> B.getLine
    a <- replicateM n (parse <$> B.getLine)
    print $ wrap h w a

module Main(main) where

import Control.Monad
import Data.Functor
import Data.List

isDigit x = x>='0' && x<='9'
split f l@(a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Int]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs
readNlines n = go 0 where
	go i = do
			a<-getLine
			go $ i-1

p = 1000000007

main = do
	l <- getLine
	let [h, w, n] = readInts l
	let srt = sortBy (\x y -> compare (sum x) (sum y))
	blacks <- (srt) <$> replicateM n (readInts <$> getLine)
	putStrLn $ show blacks

module Main(main) where

import Control.Monad(replicateM)
import Data.Functor
import Data.List
import Data.Array

isDigit x = x>='0' && x<='9'
split f l@(a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Int]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs

factorials = go 0 1 where
	go 100001 _ = []
	go i j = (i,j):(go (i+1) ((j*(i+1)) `rem` p))

p::Int
p = 1000000007
(<**>) x y = (x * y) `rem` p
(<+>) x y = let t = x + y in if t < p then t else t-p
(<->) x y = let t = x - y in if t < 0 then t+p else t
pow x 0 = 1
pow x a = let ll = pow (x<**>x) (a `quot` 2) in if a `rem` 2 > 0 then (ll <**> x) else ll
inverse x = pow x (p-2)
facs = array (0, 100000) factorials
ifacs = array (0, 100000) $ map (\(x,y) -> (x, inverse y)) factorials
choose a b
	| 0<=b && 0<=a = (facs ! (a+b)) <**> (ifacs ! a) <**> (ifacs ! b)
	| otherwise = 0

dp (prev) me@((i, j)) =
	let
		fn (d, (a, b)) = d <**> (choose (i-a) (j-b))
	in
		prev ++ [((choose (i-1) (j-1)) <-> (foldl (<+>) 0 $ map fn prev), me)]
runDp :: [(Int, Int)] -> [Int]
runDp l = let t = foldl dp ([]) l in map fst t
--runDp (a:as) = let

main = do
	l <- getLine
	let [h, w, n] = readInts l
	let srt = sortBy (\x y -> compare (sum x) (sum y))
	blacks <- ((map (\x->(head x, x!!1))).srt) <$> replicateM n (readInts <$> getLine)
	let all = blacks ++ [(h, w)]
	putStrLn $ show $ head.reverse.runDp $ all