import Control.Monad
import Data.List (foldl')
import Data.Int

readIntList = fmap ((map read) . words) getLine :: IO [Int64]

inf = 1000000000000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf
        then print (-1)
        else print ans

solve :: [Int64] -> [String] -> (Int64,Int64,String) -> Int64
solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

import Control.Monad
import Data.List (foldl')
import Data.Int

readIntList = fmap ((map read) . words) getLine :: IO [Int64]

inf = 1000000000000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf then print (-1) else print ans

solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

import Data.List (foldl')
data ExtInt = Finite Integer | Infinity deriving (Eq, Ord)
type Iter = (String, ExtInt, String, ExtInt)

plus :: ExtInt -> ExtInt -> ExtInt
(Finite a) `plus` (Finite b) = Finite (a + b)
_ `plus` _ = Infinity

extract :: ExtInt -> Integer
extract (Finite a) = a
extract Infinity   = (-1)

solve :: [Integer] -> [String] -> Integer
solve vals strs = let (_, u, _, v) = foldl' f ("", Finite 0, "", Finite 0) (zip vals strs) in extract (min u v)

f :: Iter -> (Integer, String) -> Iter
f (s, c, s', c') (k, t) = (t, min w x, t', min y z)
    where t' = reverse t
          k' = Finite k
          w  = if s  <= t  then c  else Infinity
          x  = if s' <= t  then c' else Infinity
          y  = if s  <= t' then c  `plus` k' else Infinity
          z  = if s' <= t' then c' `plus` k' else Infinity

main = do getLine
          vals <- getLine
          strs <- getContents
          putStrLn . show $ solve (map read $ words vals) (lines strs)

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

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

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = 10^18
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = 10^18
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

    m = min a b

  if m == 10^18
     then print $ -1
     else print m

import Control.Monad
import Data.List (foldl')

readIntList = fmap ((map read) . words) getLine :: IO [Int]

inf = 1000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf
        then print (-1)
        else print ans

solve :: [Int] -> [String] -> (Int,Int,String) -> Int
solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)

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

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n getLine

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s < t
            c2 = s < (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' < t
            c2 = s' < (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

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

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s < t
            c2 = s < (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' < t
            c2 = s' < (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)

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

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n getLine

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

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

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

import Data.List (foldl')
data ExtInt = Finite Int | Infinity deriving (Eq, Ord)
type Iter = (String, ExtInt, String, ExtInt)

plus :: ExtInt -> ExtInt -> ExtInt
(Finite a) `plus` (Finite b) = Finite (a + b)
_ `plus` _ = Infinity

extract :: ExtInt -> Int
extract (Finite a) = a
extract Infinity   = (-1)

solve :: [Int] -> [String] -> Int
solve vals strs = let (_, u, _, v) = foldl' f ("", Finite 0, "", Finite 0) (zip vals strs) in extract (min u v)

f :: Iter -> (Int, String) -> Iter
f (s, c, s', c') (k, t) = (t, min w x, t', min y z)
    where t' = reverse t
          k' = Finite k
          w  = if s  <= t  then c  else Infinity
          x  = if s' <= t  then c' else Infinity
          y  = if s  <= t' then c  `plus` k' else Infinity
          z  = if s' <= t' then c' `plus` k' else Infinity

main = do getLine
          vals <- getLine
          strs <- getContents
          putStrLn . show $ solve (map read $ words vals) (lines strs)


import Data.List
import Data.Int
main = interact exec
exec = show . (\(_:xs) -> solve xs) . map read . words
solve :: [Int64] -> Int64
solve = fmap sum  ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t in (t', t')) 0) >>= zipWith (\a b -> a - b - 1))

import Data.List
import Data.Int
main = interact (show . (fmap sum ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t :: Int64 in (t', t')) 0) >>= zipWith (\a b -> a - b - 1)) . tail) . map read . words)

import Data.List
main = interact exec
exec = show . (\(_:xs) -> solve xs) . map read . words
solve :: [Int] -> Int
solve = fmap sum  ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t in (t', t')) 0) >>= zipWith (\a b -> a - b - 1))


{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.IntMap.Strict as MP (insertWith, delete, findMax, empty, adjust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (intercalate)
import qualified Data.Array.MArray.Safe as A (newArray, writeArray, getElems)
import qualified Data.Array.ST.Safe as ST (STUArray)
import qualified Control.Monad.ST.Safe as ST (runST, ST)
import qualified Data.STRef as ST (STRef, newSTRef, readSTRef, modifySTRef)
import qualified Control.Monad as M (forM_)

readInt = fst . M.fromJust . C.readInt

run n k xs = ST.runST $ do
    ans <- A.newArray (0, n - 1) 0 :: ST.ST s (ST.STUArray s Int Int)
    cost <- ST.newSTRef 0 :: ST.ST s (ST.STRef s I.Int64)
    mset <- ST.newSTRef MP.empty
    let (xsl, xsr) = splitAt k (zip xs [0..])
    M.forM_ xsl $ \(x, i) -> do
        ST.modifySTRef mset (MP.insertWith (++) x [i])
    M.forM_ xsr $ \(x, i) -> do
        ST.modifySTRef mset (MP.insertWith (++) x [i])
        (MP.findMax -> (xa, (xb:xt))) <- ST.readSTRef mset
        ST.modifySTRef cost (+ fromIntegral xa * fromIntegral (i - xb))
        A.writeArray ans xb (i + 1)
        if xt == [] then ST.modifySTRef mset (MP.delete xa)
        else ST.modifySTRef mset (MP.adjust (const xt) xa)
    M.forM_ [n..n + k - 1] $ \i -> do
        (MP.findMax -> (xa, (xb:xt))) <- ST.readSTRef mset
        ST.modifySTRef cost (+ fromIntegral xa * fromIntegral (i - xb))
        A.writeArray ans xb (i + 1)
        if xt == [] then ST.modifySTRef mset (MP.delete xa)
        else ST.modifySTRef mset (MP.adjust (const xt) xa)
    ans <- A.getElems ans
    cost <- ST.readSTRef cost
    return (cost, ans)

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    let (cost, ans) = run n k xs
    print (cost :: I.Int64)
    putStrLn $ L.intercalate " " $ map show $ ans

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, FlexibleContexts, Rank2Types, ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int
import qualified Data.Set as S
import Data.Array.ST.Safe
import Control.Monad.ST.Safe
import Data.Array.Unboxed

main = SB.putStr . SB.unlines . map (SB.pack . show) . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  k <- poi
  cs <- replicateM n poi
  return $ solve n k cs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve n k cs = elems $ runSTUArray $ do
  arr <- newArray (0, n) 0 :: ST s (STUArray s Int Int64)
  foldM_ (go arr) ((\(f, s) -> (S.fromList f, s)) . splitAt k $ flip (zipWith P) [1..] $ map to64 cs) [to64 (k + 1)..to64 (k + n)]
  return arr
  where
  go arr (!f, !ss) t = do
    tot <- readArray arr 0
    writeArray arr 0 (tot + (t - i) * c)
    writeArray arr (fromIntegral i) t
    return (f', ss')
    where
    ((P c i, f'), ss') = (\(a, b) -> (S.deleteFindMax a, b)) $ case ss of
      [] -> (f, [])
      s:rs -> (S.insert s f, rs)

data P = P !Int64 !Int64 deriving (Eq, Show, Ord)


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

zipPairs f [] = []
zipPairs f (x:y:xs) = (f x y):zipPairs f xs

dist [x1, y1] [x2, y2] = abs (x1 - x2) + abs (y1 - y2)
dists pts = {-trace (show pts) $ -}zipPairs (+) $ zipWith dist pts (tail pts)

findD have [] = Just []
findD have (x:xs) | null av = Nothing
                  | otherwise = (head av:) <$> findD (M.insert x (tail av) have) xs
  where
    av = M.findWithDefault [] x have

format xs = (-1:(intersperse (-1) xs)) ++ [-1]

solve :: [[Int]] -> M.Map Int [Int] -> Maybe [Int]
solve pts lens = tail <$> try (last pts : pts) <|>
                 take (length pts) <$> try (pts ++ [head pts])
  where
    try pts = format <$> findD lens (dists pts)

buildMap xs = M.fromListWith (++) $ zip xs $ map pure [1..]

main = do
  [n, _] <- map read <$> words <$> getLine
  pts <- replicateM n $ map read <$> words <$> getLine
  lens <- map read <$> words <$> getLine
  case solve pts (buildMap lens) of
    Nothing -> putStrLn "NO"
    Just res -> (putStrLn "YES") >> (putStrLn $ unwords $ map show res)

import Control.Monad (liftM, replicateM, replicateM_)
import Data.IntMap (findWithDefault, fromListWith, member, update)
import Data.List (delete, intercalate)
import Prelude hiding (reads)

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

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

toPair :: [a] -> (a, a)
toPair [a, b]  =  (a, b)

solve :: [(Int, Int)] -> [Int] -> Maybe [Int]
solve ps as  =  case solve2 of
  Nothing  ->  solve1
  Just qs  ->  Just (last qs : init qs)
  where
    map'  =  fromListWith (++) $ zip as $ map (\x -> [x]) [1..]
    solve1  =  solve' (last ps : ps) map' []
    solve2  =  solve' (ps ++ [head ps]) map' []
    solve' [_] _ ans  =  Just $ reverse ans
    solve' ((x1, y1) : (x2, y2) : (x3, y3) : ps) map' ans
      | l `member` map'  =  solve' ((x3, y3) : ps) (update tail' l map') (-1 : num : ans)
      | otherwise  =  Nothing
      where
        num  =  head $ findWithDefault [] l map'
        tail' [x]  =  Nothing
        tail' xs  =  Just $ tail xs
        l  =  sum [abs (x1-x2), abs (y1-y2), abs (x2-x3), abs (y2-y3)]

print' :: Maybe [Int] -> IO ()
print' Nothing  =  putStrLn "NO"
print' (Just xs)  =  putStrLn "YES" >> prints xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM n reads
    as  <-  reads
    print' $ solve (map toPair ps) as

import Control.Monad (liftM, replicateM, replicateM_)
import Data.IntMap (findWithDefault, fromListWith, member, update)
import Data.List (delete, intercalate)
import Prelude hiding (reads)

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

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

toPair :: [a] -> (a, a)
toPair [a, b]  =  (a, b)

solve :: [(Int, Int)] -> [Int] -> Maybe [Int]
solve ps as  =  case solve2 of
  Nothing  ->  solve1
  Just qs  ->  Just (tail qs ++ [head qs])
  where
    map'  =  fromListWith (++) $ zip as $ map (\x -> [x]) [1..]
    solve1  =  solve' (last ps : ps) map' []
    solve2  =  solve' (ps ++ [head ps]) map' []
    solve' [_] _ ans  =  Just $ reverse ans
    solve' ((x1, y1) : (x2, y2) : (x3, y3) : ps) map' ans
      | l `member` map'  =  solve' ((x3, y3) : ps) (update tail' l map') (-1 : num : ans)
      | otherwise  =  Nothing
      where
        num  =  head $ findWithDefault [] l map'
        tail' [x]  =  Nothing
        tail' xs  =  Just $ tail xs
        l  =  sum [abs (x1-x2), abs (y1-y2), abs (x2-x3), abs (y2-y3)]

print' :: Maybe [Int] -> IO ()
print' Nothing  =  putStrLn "NO"
print' (Just xs)  =  putStrLn "YES" >> prints xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM n reads
    as  <-  reads
    print' $ solve (map toPair ps) as


import Control.Applicative
import Data.List

solve :: [[Int]] -> Int
solve [a,b] = sum $ zipWith (*) a $ tail $ scanl min 101 b

parse :: String -> [[Int]]
parse = transpose.(fmap $ fmap read).fmap words.lines

main = do
    getLine
    l <- getContents
    print.solve $ parse l

module Main where

import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L

parseInt :: L.ByteString -> Int
parseInt bs = case L.readInt bs of
                Just (x, _) -> x
                Nothing     -> error $ "Can't parse Int from: " ++ (L.unpack bs)

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (a:p:vs) bestPrice | p < bestPrice = a * p + solve vs p
                         | otherwise = a * bestPrice + solve vs bestPrice

main :: IO ()
main = do
  (_:vs) <- liftM (map parseInt . L.words) L.getContents
  print $ solve vs maxBound

main = interact $ show . solve . parse
  where parse = group2 . map read . tail . words
        group2 (x:y:zs) = (x, y) : group2 zs
        group2 [] = []

solve :: [(Int, Int)] -> Int
solve = fst . foldl folder (0, maxBound)
  where folder (acc, minCost) (a, p) = (acc + a * mC', mC')
          where mC' = min minCost p

main = do
         line <- getLine
         let n = read line :: Int
         inputLines <- fmap (take n . lines) getContents
         let input = [(tokens!!0,tokens!!1) | line <- inputLines, let tokens = map read (words line)] :: [(Int, Int)]
         let mins = scanl1 (\x y -> minimum [x,y]) (map snd input)
         let days = map fst input
         let cost = foldl (\x y -> x+(fst y * snd y)) 0 $ zip mins days
         putStrLn $ show cost

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

solve :: Int -> [Int] -> Int
solve _ []      = 0
solve m (a:p:x) = let n = min m p
                  in n * a + solve n x

main = do
  getLine
  (as, ps) <- fmap (unzip . map ((\[a, b] -> (a, b)) . map read . words) . lines) getContents

  let ms = scanl1 min ps

  print $ sum $ zipWith (*) as ms

main = interact $ show . f 1000 . map read . tail . words
f _ [] = 0
f x (a:p:ap) = f p' ap + p' * a where p' = min x p

main = interact $ show . solve 100 . tail . map read . words
solve _ [] = 0
solve cMin (a : p : xs) = let nMin = min cMin p in nMin * a + solve nMin xs

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
answer::[[Int]] -> Int -> Int
answer [] _ = 0
answer ([a,p]:ps) pmin = a*nextMin+ answer ps nextMin
    where nextMin = min p pmin
main = do
  n <- readLn::IO Int
  a <- readMatrix
  print $ answer a (maxBound::Int)

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = readLn >>= \ n -> solve =<< forM [1..n] (\i-> map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = print $ sum $ map (\[a,b]->a*b) $ tail $ slv1 xs
slv1 xs = scanl (\[b1,b2] [a1,a2]  -> [a1, minimum [b2,a2]]) (head xs) xs

import Control.Monad
import Data.List

main = do
 n <- liftM (\x->read x::Int) getLine
 aps <- liftM (map ((\[x,y]->(x,y)) . map (\x->read x::Int).words)) $replicateM n getLine
 print $ fst
       $ foldl' (\(sum, p')  (a,p)  -> let p'' = min p p' in (sum + p''*a, p'')) ((\(x,y) -> (x*y,y))
       $ (head aps))
       $ tail aps

import Control.Applicative

process s _ [] = s
process s m ([a1,a2]:as) = process (s+a1*(min m a2)) (min m a2) as

main::IO ()
main=do
   n<-read <$> getLine ::IO Int
   x<- map(map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
   print $ process 0 10000 x

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

solve :: [[Int]] -> Int
solve = fst . foldl (\(s, q) [a, p] -> (s + a * min p q, min p q)) (0, 100)

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

solve :: [(Int, Int)] -> Int
solve = fst . foldl (\(s, q) (a, p) -> (s + a * min p q, min p q)) (0, 1000000000)

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

main = interact $ show . uncurry solve . parse
parse = unzip . pairs . map read . tail . words
pairs (x:y:z) = (x,y) : pairs z
pairs [] = []
solve as ps = sum $ zipWith (*) as (scanl1 min ps)

minPrice' :: [(Int, Int)] -> Int
minPrice' [x] = prod x
minPrice' (x:xs)
  | snd x > snd (head xs) = prod x + minPrice' (xs)
  | otherwise = prod x + minPrice' ((fst (head xs), snd x) : tail xs)

prod :: Num a => (a, a) -> a
prod (a,b) = a*b

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

main :: IO ()
main = do
  inputNum <- readLn
  ans <- fmap minPrice' (getInput inputNum)
  print ans

getInput :: Int -> IO [(Int, Int)]
getInput 0 = return []
getInput n = do
  x <- getLine
  let numAmtPrice = map read (words x) :: [Int]
      as = head numAmtPrice
      ps = last numAmtPrice
  nextLine <- getInput (n-1)
  return ((as, ps) : nextLine)

minPrice :: [Int] -> [Int] -> Int
minPrice as ps = thrd final where
  final = foldl1 (\acc x -> if snd1 acc > snd1 x then
    (1, snd1 x, (snd1 x * fst1 x) + thrd acc)
    else (1, snd1 acc, (snd1 acc * fst1 x) + thrd acc)) (zip3 as ps ds)
  ds = (head as * head ps) : repeat 0

fst1 (a, _, _) = a
snd1 (_, b, _) = b
thrd (_, _, c) = c

getInput :: Int -> IO [(Int, Int)]
getInput 0 = return []
getInput n = do
  line <- getLine
  let as = head $ map read (words (line)) :: Int
      ps = last $ map read (words (line)) :: Int
  next <- getInput (n-1)
  return ((as, ps) : next)

main :: IO ()
main = do
  numInput <- readLn
  vals <- getInput numInput
  let as = map fst vals
      ps = map snd vals
      ans = minPrice as ps
  print ans

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

solve :: [[Int]] -> Int -> Int
solve [] _ = 0
solve ([a,p]:xs) mn = a*nextmn + solve xs nextmn
    where
        nextmn = min mn p

main :: IO ()
main = do
    n <- readLn :: IO Int
    ap <- map (map fst . mapMaybe C.readInt . C.words) <$> replicateM n C.getLine
    print $ solve ap 101

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

process [] _ s = s
process ([a,p]:as) x s | p<=x = process as p (s+p*a)
                       | otherwise = process as x (s+x*a)

main=do
	getLine
	r<- map (map (fst.fromJust.C.readInt)). map C.words. C.lines <$> C.getContents:: IO [[Int]]
	print $ process r 1000 0

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

process [] _ s = s
process ([a,p]:as) x s | p<=x = process as p (s+p*a)
                       | otherwise = process as x (s+x*a)

main=do
	getLine
	r<- map (map read). map words.lines <$> getContents:: IO [[Int]]
	print $ process r 1000 0

process :: [Int] -> [Int] -> Int
process as ps = sum $ zipWith (*) as ps'
    where ps' = scanl1 min ps

readInt :: String -> Int
readInt = read

readPair :: String -> (Int, Int)
readPair s = (l,r)
    where [l,r] = (map readInt.words) s

main :: IO ()
main = do
    t <- fmap readInt getLine
    (as,ps) <- fmap (unzip.map readPair.lines) getContents
    print $ process as ps

import Data.Char

minimumMoney :: [Int] -> [Int] -> Int -> IO Int
minimumMoney [] [] min = return 0
minimumMoney (a:as) (p:ps) min = if p < min then (do m <- minimumMoney as ps p
						     return (a*p + m))
					    else (do m <- minimumMoney as ps min
						     return (a*min + m))

getNumbers :: Int -> IO ([Int],[Int])
getNumbers 0 = return ([],[])
getNumbers n = do s <- getLine
		  let (a',rest) = span isDigit s
		      (p',rest') = span isDigit (tail rest)
		      a = read a' :: Int
		      p = read p' :: Int in do (as,ps) <- getNumbers (n-1)
					       return (a:as,p:ps)

main :: IO()
main = do s <- getLine
	  let n = read s :: Int in do (as,ps) <- getNumbers n
				      result <- minimumMoney as ps (2*10^9)
				      print result

main :: IO ()
main = interact solve

accumulator :: (Int, Int) -> [Int] -> (Int, Int)
accumulator (_, _) [] = undefined
accumulator (_, _) [_] = undefined
accumulator (total, bestPrice) (a:p:_) = (total', bestPrice')
    where bestPrice' = min bestPrice p
          total' = total + a * bestPrice'

solve :: String -> String
solve s = show $ fst $ foldl accumulator (0, 200) xs
    where xs = fmap (fmap read . words) (tail $ lines s) :: [[Int]]

import Data.List (sort, sortBy)

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

solve :: [(Int, Int)] -> Int
solve xas = sum $ zipWith (\(_, x) (_, y) -> x + y) (sort (filter ((>0) . fst) xas) ++ [(0, 0)]) (sortBy (flip compare) (filter ((<0) . fst) xas) ++ [(0, 0)])

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

import Data.Char

minimumMoney :: [Int] -> [Int] -> IO Int
minimumMoney [] [] = return 0
minimumMoney (a:as) (p:ps) = if minimum (p:ps) == p then return (p*sum (a:as)) else do m <- minimumMoney as ps
										       return (a*p + m)

getNumbers :: Int -> IO ([Int],[Int])
getNumbers 0 = return ([],[])
getNumbers n = do s <- getLine
		  let (a',rest) = span isDigit s
		      (p',rest') = span isDigit (tail rest)
		      a = read a' :: Int
		      p = read p' :: Int in do (as,ps) <- getNumbers (n-1)
					       return (a:as,p:ps)

main :: IO()
main = do s <- getLine
	  let n = read s :: Int in do (as,ps) <- getNumbers n
				      result <- minimumMoney as ps
				      print result


import Data.List (nub)
main = do
  n <- readLn
  as <- fmap (map read . tail . words) getLine
  bs <- fmap (map read . tail . words) getLine
  putStrLn $ if length (nub (as ++ bs :: [Int])) == n then "I become the guy." else "Oh, my keyboard!"

import Control.Monad
import Control.Applicative
import Data.List (sort, nub)
main = do
  n <- readLn :: IO Int
  aa <- map read . words <$> getLine
  bb <- map read . words <$> getLine
  let xs = tail aa
      ys = tail bb
      p = head aa
      q = head bb
      levels = sort (nub $ xs ++ ys) == [1..n]
  putStrLn $ if levels then "I become the guy." else "Oh, my keyboard!"

import Data.List

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

printResult :: Bool -> IO()
printResult b = putStrLn (if b then "I become the guy." else "Oh, my keyboard!")

solve :: [Int] -> Bool
solve (n:na:x) =
    let a = take na x
        b = drop (na + 1) x
    in  (length $ nub (a ++ b)) == n

import Data.List

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

spanning lst cnt
  | (null lst) = cnt
  | (head lst) == (cnt+1) = spanning (tail lst) (cnt+1)
  | otherwise = spanning (tail lst) cnt

main = do
  ss <- getLine
  let ii = (read ss)::Int
  ww <- getLine
  oo <- getLine
  let qq = (tail (conv (words ww) []))
      cc = (tail (conv (words oo) []))
      jj = qq ++ cc
      hh = sort jj
      spans = spanning hh 0
  if spans < ii
    then putStrLn "Oh, my keyboard!"
    else putStrLn "I become the guy."

import Data.List

-- Snippet: readItems
readItems = do
    line <- getLine
    return $ map read $ words line

main = do
    n <- readLn
    a1 <- readItems
    a2 <- readItems
    putStrLn $ if null ([1 .. n] \\ ((tail a1) ++ (tail a2)))
               then "I become the guy."
               else "Oh, my keyboard!"

import Data.Set

main = interact $ g.f
f inp = (Prelude.map (\x -> Prelude.map read (words x) :: [Integer]) (lines inp))

a (x:y:z:[]) = head x
b (x:y:z:[]) = tail y
c (x:y:z:[]) = tail z

g inp
  | fromList [1..(a inp)] == union (fromList (b inp)) (fromList (c inp)) = "I become the guy."
  | otherwise = "Oh, my keyboard!"

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . getAns . getIntArray

getAns :: [Int] -> String
getAns (n:p:xs) = if ([1..n] == sort (union ls rs)) then "I become the guy." else "Oh, my keyboard!"
			where (ls, (_:rs)) = splitAt p xs

import Data.List

main = do
  n <- readLn
  as <- fmap (map read . words) getLine
  bs <- fmap (map read . words) getLine

  putStrLn $ if sort (nub (tail as ++ tail bs)) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList an) (HS.fromList bn)) == n
        then putStrLn "I become the guy."
        else putStrLn "Oh, my keyboard!"

import Data.List as L
solve [[n],_:a,_:b] = length (L.nub $ L.sort (a++b) ) == n
tores True = "I become the guy."
tores False = "Oh, my keyboard!"
main = interact $ tores . solve . map (map read . words) . lines

import qualified Data.Set as S

main = do
   n <- fmap read getLine
   (p:ls) <- fmap (map read . words) getLine
   (q:ls') <- fmap (map read . words) getLine
   printSol (solve n (S.fromList ls) (S.fromList ls'))

printSol True = putStrLn "I become the guy."
printSol False = putStrLn "Oh, my keyboard!"

solve :: Int -> S.Set Int -> S.Set Int -> Bool
solve n s s' = n == S.size (S.union s s')

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.ttail.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = if x/=0 then x:(solve [y|y<-xs, y/=x, y/=0]) else solve [y|y<-xs, y/=x, y/=0]
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"
ttail (xs:xss) =xs : map tail xss

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import qualified Data.List as List
import qualified Data.Set as Set

solve :: Int -> [Int] -> [Int] -> Bool
solve n a b = List.all id $ map (\i -> Set.member i s) [1 .. n]
  where
    s = Set.fromList (a ++ b)

ans :: Bool -> String
ans True  = "I become the guy."
ans False = "Oh, my keyboard!"

main :: IO ()
main = do
  n     <- read <$> getLine
  _ : a <- (map read . words) <$> getLine
  _ : b <- (map read . words) <$> getLine
  putStrLn $ ans $ solve n a b

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- L.nub . tail . map read . words <$> getLine :: IO [Int]
  ys <- L.nub . tail . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

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

solve :: Int -> [Int] -> [Int] -> Bool
-- solve lv a b = all (liftM2 (||) (`elem` a) (`elem` b)) [1..lv]
solve lv a b = (==[1..lv]) . map head . group . sort $ a ++ b

main :: IO ()
main = do
        lv <- fmap read getLine
        a  <- fmap tail getIntList
        b  <- fmap tail getIntList
        putStrLn $ if solve lv a b then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import Data.List

main = do
  n <- readLn
  (_:xs) <- map read . words <$> getLine :: IO [Int]
  (_:ys) <- map read . words <$> getLine :: IO [Int]
  let
    l = length . group . sort $ xs ++ ys
   in putStrLn $ if l == n then "I become the guy." else "Oh, my keyboard!"

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

main=do
      n<- read <$> getLine ::IO Int
      a<- (replicateM 2 (tail <$> map read <$>   words   <$> getLine))::IO [[Int]]
      let b = length $ map head $ group $ sort $ concat a
      putStrLn $ if n==b then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub, sort)

main :: IO ()
main = getContents >>= putStrLn . output . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[n], (_:xs), (_:ys)] = length (nub (xs ++ ys)) == n

output :: Bool -> String
output True = "I become the guy."
output _ = "Oh, my keyboard!"

import Data.List (nub, sort)

main :: IO ()
main = getContents >>= putStrLn . output . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[n], (_:xs), (_:ys)] = sort (nub (xs ++ ys)) == [1..n]

output :: Bool -> String
output True = "I become the guy."
output _ = "Oh, my keyboard!"

-- Vicfred
-- https://codeforces.com/problemset/problem/469/A

import Data.List

main :: IO ()
main = do
  n <- readLn :: IO Int
  a <- getLine >>= return. tail. map read. words :: IO [Int]
  b <- getLine >>= return. (++a). tail. map read. words :: IO [Int]
  putStrLn $ if n == (length. nub $ b) then "I become the guy." else "Oh, my keyboard!"

-- Vicfred
-- https://codeforces.com/problemset/problem/469/A

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

getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Int -> [Int] -> [Int] -> Bool
solve lv a b = (==[1..lv]) . map head . group . sort $ a ++ b

main :: IO ()
main = do
    lv <- fmap read getLine
    a  <- fmap tail getIntList
    b  <- fmap tail getIntList
    putStrLn $ if solve lv a b then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.Set  as S

main= do
	n<- read <$> getLine  :: IO Int
	x<- tail.map read. words <$> getLine::IO [Int]
	y<- tail.map read. words <$> getLine::IO [Int]
	putStrLn $  if length (S.toList(S.fromList(x++y)))==n then "I become the guy." else "Oh, my keyboard!"

import Data.List
main = do
  n <- readLn :: IO Int
  a <- getLine >>= return. tail. map read. words :: IO [Int]
  b <- getLine >>= return. (++a). tail. map read. words :: IO [Int]
  putStrLn $ if n == (length. nub $ b) then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    s1 <- tail . map (read :: String -> Int) . words <$> getLine
    s2 <- tail . map (read :: String -> Int) . words <$> getLine
    putStrLn $ if sort (s1 `union` s2) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    comb <- sort . uncurry union . (\[a,b]->(a,b)) . map (tail . map (read :: String -> Int) . words) <$> sequence [getLine, getLine]
    putStrLn $ if length comb == n then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub)

process :: Int -> [Int] -> [Int] -> Bool
process n ps qs = n == length (nub (ps ++ qs))

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    (p:ps) <- fmap (map readInt.words) getLine
    (q:qs) <- fmap (map readInt.words) getLine
    putStrLn $ ["Oh, my keyboard!","I become the guy."] !! fromEnum (process n ps qs)

import Data.List
main = do
    let readint = read :: String -> Int
    n <- fmap readint getLine
    m <- fmap (length . nub . concat . map (tail . map readint . words) . lines) getContents
    putStrLn $ if m == n then "I become the guy." else "Oh, my keyboard!"

import Data.List

main = interact $ (\(n:p:xs) -> if n == (length . nub $ drop (p+1) xs ++ take p xs) then "I become the guy." else "Oh, my keyboard!") . map read . words

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | (length . group . sort) (xs ++ ys) == n = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . tail. words) . tail $ l

main :: IO ()
main = interact $ solve

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | n == length (nub (xs ++ ys)) = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . tail. words) . tail $ l

main :: IO ()
main = interact $ solve

import Control.Monad
import Control.Applicative
import Data.List (nub)

main = do
  n <- readLn :: IO Int
  aa <- map read . words <$> getLine
  bb <- map read . words <$> getLine
  let xs = tail aa
      ys = tail bb
      p = head aa
      q = head bb
      levels = (nub $ xs ++ ys) == [1..n]
  putStrLn $ if levels then "I become the guy." else "Oh, my keyboard!"

import Data.List

main = do
  n <- readLn
  as <- fmap (map read . words) getLine
  bs <- fmap (map read . words) getLine

  putStrLn $ if sort (nub (as ++ bs)) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList ps) (HS.fromList qs)) == n
        then putStrLn "I become the guy."
        else putStrLn "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList ps) (HS.fromList qs)) == n
        then putStrLn "I become the guy"
        else putStrLn "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = if x/=0 then x:(solve [y|y<-xs, y/=x, y/=0]) else solve [y|y<-xs, y/=x, y/=0]
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = x:(solve [y|y<-xs, y/=x, y/=0])
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = x:(solve [y|y<-xs, y/=x])
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- L.nub . map read . words <$> getLine :: IO [Int]
  ys <- L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- filter (/=0) . L.nub . map read . words <$> getLine :: IO [Int]
  ys <- filter (/=0) . L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- tail . L.nub . map read . words <$> getLine :: IO [Int]
  ys <- tail . L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import Data.List

main=do
      n<- read <$> getLine ::IO Int
      a<-concatMap (map read) <$> map words <$> lines <$> getContents ::IO [Int]
      let b = length $ map head $ group $ sort a
      putStrLn $ if n==b then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub)
main = do
  n <- readLn
  as <- fmap (map read . tail . words) getLine
  bs <- fmap (map read . tail . words) getLine
  putStrLn $ if length (nub (as ++ bs :: [Int])) == n then "I become the guy" else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    s1 <- tail . map (read :: String -> Int) . words <$> getLine
    s2 <- tail . map (read :: String -> Int) . words <$> getLine
    putStrLn $ if union s1 s2 == [1..n] then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    comb <- sort . uncurry union . (\[a,b]->(a,b)) . map (map (read :: String -> Int) . words) <$> sequence [getLine, getLine]
    putStrLn $ if comb == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | (length . group . sort) (xs ++ ys) == n = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . words) . tail $ l

main :: IO ()
main = interact $ solve


{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n (BS.unpack <$> readLine)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStr =<< solve . evalState parseInput <$> BS.getContents

data Widget = Widget { name :: String, width :: Integer, height :: Integer }
            | VBox { name :: String, border :: Integer, spacing :: Integer, contains :: [String] }
            | HBox { name :: String, border :: Integer, spacing :: Integer, contains :: [String] }

solve :: [String] -> String
solve seq = unlines $ map (show . calcWidget mapping) (Map.keys mapping)
  where
    mapping = execState (sequence_ $ map simulating seq) Map.empty

simulating :: String -> State (Map String Widget) ()
simulating ('V':'B':'o':'x':' ':name) = modify $ Map.insert name (VBox name 0 0 [])
simulating ('H':'B':'o':'x':' ':name) = modify $ Map.insert name (HBox name 0 0 [])
simulating ('W':'i':'d':'g':'e':'t':' ':def) = modify $ Map.insert name (Widget name x y)
  where
    (name, xy) = span (/='(') def
    (x, y) = read xy
simulating stmt
    | op == ".pack"        = modify $ Map.update (Just . addContains param) name
    | op == ".set_border"  = modify $ Map.update (Just . setBorder (read param)) name
    | op == ".set_spacing" = modify $ Map.update (Just . setSpacing (read param)) name
  where
    (name, stmt2) = span (/='.') stmt
    (op, stmt3) = span (/='(') stmt2
    param = tail $ init stmt3

addContains chd (VBox name border spacing contains) = VBox name border spacing (chd:contains)
addContains chd (HBox name border spacing contains) = HBox name border spacing (chd:contains)

setSpacing spacing (VBox name border _ contains) = VBox name border spacing contains
setSpacing spacing (HBox name border _ contains) = HBox name border spacing contains

setBorder border (VBox name _ spacing contains) = VBox name border spacing contains
setBorder border (HBox name _ spacing contains) = HBox name border spacing contains

calcWidget mapping = (cache Map.!)
  where
    cache = Map.fromList [(names, goName names) | names <- Map.keys mapping]

    goName name = go (mapping Map.! name)
    go w@(Widget _ _ _) = w
    go (VBox name _ _ []) = Widget name 0 0
    go (HBox name _ _ []) = Widget name 0 0
    go (VBox name border spacing contains) = Widget name (maximum widths + border * 2) (sum heights + (len - 1) * spacing + border * 2)
      where
        widgets = map (calcWidget mapping) contains
        heights = map height widgets
        widths = map width widgets
        len = genericLength widgets

    go (HBox name border spacing contains) = Widget name (sum widths + (len - 1) * spacing + border * 2) (maximum heights + border * 2)
      where
        widgets = map (calcWidget mapping) contains
        heights = map height widgets
        widths = map width widgets
        len = genericLength widgets

instance Show Widget where
    show (Widget name x y) = name ++ " " ++ show x ++ " " ++ show y

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Text.ParserCombinators.ReadP hiding (get)
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Traversable hiding (mapM)
import Data.List
import Data.Function
import Data.Map(Map, (!))
import qualified Data.Map as Map
-- import Data.MemoTrie

instance Applicative ReadP where
  pure x = return x
  f <*> x = do
    f' <- f
    x' <- x
    return (f' x')

data Statement =
 Widget String Integer Integer
 | HBox String
 | VBox String
 | Pack String String
 | SetBorder String Integer
 | SetSpacing String Integer
 deriving (Show)

identifier = munch (\c -> isAlpha c || c=='_')

translateCommand :: String -> String -> String -> Statement
translateCommand w1 "pack" w2 = Pack w1 w2
translateCommand w1 "set_border" x = SetBorder w1 (read x)
translateCommand w1 "set_spacing" x = SetSpacing w1 (read x)

integer :: ReadP Integer
integer = read <$> munch isDigit

parseStatement = choice
  [
    Widget <$> (string "Widget " *> identifier) <*> (char '(' *> integer) <*> (char ',' *> integer <* char ')')
    , HBox <$> (string "HBox " *> identifier)
    , VBox <$> (string "VBox " *> identifier)
    , translateCommand <$> identifier <*> (char '.' *> identifier) <*> (char '(' *> munch (\c -> isAlpha c || isDigit c) <* char ')')
  ]

type Dimensions = (Integer, Integer)
type Spacing = Integer
type Border = Integer

data Direction = Vertical | Horisontal

data Widget = SimpleWidget Dimensions | BoxWidget Direction [String] Spacing Border

executeStatement :: Statement -> Map String Widget -> Map String Widget
executeStatement (Widget name x y) = Map.insert name (SimpleWidget (x,y))
executeStatement (HBox name) = Map.insert name (BoxWidget Horisontal [] 0 0)
executeStatement (VBox name) = Map.insert name (BoxWidget Vertical [] 0 0)
executeStatement (Pack box containee) = Map.adjust (addChild containee) box
executeStatement (SetBorder box b) = Map.adjust (setBorder b) box
executeStatement (SetSpacing box b) = Map.adjust (setSpacing b) box

addChild containee (BoxWidget d ch s b) = BoxWidget d (containee : ch) s b
setBorder border (BoxWidget d c s _b) = BoxWidget d c s border
setSpacing spacing (BoxWidget d c _s b) = BoxWidget d c spacing b

runScript :: [Statement] -> Map String Widget
runScript = foldl (flip executeStatement) Map.empty

memo :: ((String -> InMemo Dimensions) -> (String -> InMemo Dimensions)) -> (String -> InMemo Dimensions)
memo f = mf where
  mf k = do
    m <- get
    case Map.lookup k m of
      Nothing -> do
        x <- f mf k
        put $ Map.insert k x m
        return x
      Just x -> return x

put :: Map String Dimensions -> InMemo ()
put m = InMemo $ \_ -> ((), m)

get :: InMemo (Map String Dimensions)
get = InMemo $ \m -> (m, m)

data InMemo a = InMemo { runMemo :: Map String Dimensions -> (a, Map String Dimensions) }

instance Functor InMemo where
  fmap f x = x >>= return . f
instance Monad InMemo where
  x >>= f = InMemo $ \s0 -> let (x', s1) = runMemo x s0 in runMemo (f x') s1
  return x = InMemo $ \s -> (x, s)

evalInMemo x s = fst $ runMemo x s

calculateM :: Map String Widget -> (String -> InMemo Dimensions) -> (String -> InMemo Dimensions)
calculateM widgets r s = case widgets ! s of
      SimpleWidget d -> return d
      BoxWidget _ [] _ _ -> return (0, 0)
      BoxWidget dir children spacing border -> sw . layout <$> mapM ((sw <$>) . r) children
        where
          layout dims = (ly (map fst dims), ly [maximum $ map snd dims])
          ly xs = sum xs + spacing * (genericLength xs - 1) + border * 2
          sw = swd dir
          swd Horisontal (x, y) = (x, y)
          swd Vertical (x, y) = (y, x)

calculate :: Map String Widget -> Map String Dimensions
calculate widgets = evalInMemo doCalculate Map.empty
  where
    doCalculate :: InMemo (Map String Dimensions)
    doCalculate = Map.fromList <$> mapM (\(key, _) -> doCalc key >>= \val -> return (key, val)) (Map.toList widgets)
    doCalc = memo (calculateM widgets)

{-calculate :: Map String Widget -> Map String Dimensions
calculate widgets = Map.mapWithKey (\k v -> mcalc k) widgets
  where
    mcalc = {- memo -} calc
    calc s =    -}

main = do
  n <- read <$> getLine
  script <- (map ((\[(r, "")] -> r) . readP_to_S parseStatement)) <$> replicateM n getLine
  mapM putStrLn $ map (\(k,(x,y)) -> unwords [k, show x, show y]) $ Map.toList $ calculate $ runScript script


import Control.Applicative
import Data.Graph

main = do
  n <- readLn :: IO Int
  p <- map read <$> words <$> getLine  :: IO [Int]
  let g = buildG (1, n) (zip [1..n] p)
  print (length (components g))

import Data.Array.IArray
import qualified Data.Array.IArray as A
import Data.Array.Unboxed
import Data.List( nub)

main = do
    n_ <- readLn::IO Int
    connections_ <- return . map read . words =<< getLine
    let
	ary = A.listArray (1,n_) connections_:: (UArray Int Int)
	backRt ix = let
			to = ary!ix
		    in
			if to < ix
			    then backRt to
			    else ix
	numTrees = let arrayList = A.elems ary
		   in length . nub $ map backRt arrayList
    print numTrees

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Foldable
import qualified Data.Set as S

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

main = do
  n <- readInt <$> B.getLine
  ps <- listArray (1, n) . readInts <$> B.getLine
  print . S.size . foldl' (\s (i, v) -> if ps!v == i then S.insert (min v i) s else s) S.empty . assocs $ ps


import Control.Monad
import Data.Int (Int64)
import Data.List (sort)

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- getLine
        print $ solve $ map fst $ filter ((== '*') . snd) $ zip [1 .. n] a

solve :: [Int64] -> Int64
solve [] = 0
solve xs' = sum $ map (abs . (m -)) xs
  where
    n = length xs'
    xs = sort $ zipWith ((-) . fromIntegral) [1 .. n] xs'
    m = xs !! div n 2

import Control.Arrow
import Data.List(sort, group)

chunksOf :: Int -> [a] -> [[a]]
chunksOf k [] = []
chunksOf k xs = let (g, xs') = splitAt k xs in g : chunksOf k xs'

type LL = Integer

main = interact $
         lines >>> drop 1 >>> chunksOf 2
         >>> map ((!! 1) >>> solve >>> show)
         >>> unlines

solve :: String -> LL
solve s =
    let xs = zipWith (-) [i | (c, i) <- zip s [0..], c == '*'] [0..]
        m = xs !! (length xs `div` 2)
    in sum $ map (abs . (m -)) xs


import Data.Function (on)
import Data.Functor ((<$>))
import Data.List (groupBy, inits, permutations, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> tail <$> map read <$> words <$> getContents

solve :: [Integer] -> Maybe [[Integer]]
solve = listToMaybe . drop 3 . inits . f . map (permutations . map fst)
      . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [1..]

f :: [[[a]]] -> [[a]]
f [] = []
f [xs] = xs
f (xs:xss) = [ x ++ xs' | x <- xs, xs' <- f xss ]

printSolution :: Show a => Maybe [[a]] -> IO ()
printSolution xs = putStrLn (maybe "NO" (const "YES") xs)
                 >> mapM_ (putStrLn . unwords . map show) (fromMaybe [] xs)

import Data.List
main = interact $ solve .map read. drop 1.words
findA index n xs acc
	|index>=n || length acc > 1 = acc
	|otherwise = if (fst $head xs)==(fst $head $tail xs) then findA (index+1) n (tail xs) (index:acc) else findA (index+1) n (tail xs) acc
printAns xs equals=
	("YES\n"++p xs++"\n")++(p $ swap xs $head equals)++"\n"++(p $ swap xs $last equals)
	where p=unwords.map show.map snd
 	      swap ys k=take (k-1) ys ++ [xs!!k, xs!!(k-1)]++drop (k+1) ys
solve :: [Int]->String
solve xs =
	if length equals>1 then printAns ys equals else "NO"
	where ys=sort $ zip xs [1..]
	      equals=findA 1 (length xs) ys []

import Data.Ord (comparing)
import Data.List (groupBy, sortBy, transpose, permutations)
import Data.Function (on)

main :: IO ()
main = do
    _ <- getLine
    xs <- (fmap (map read . words) getLine) :: IO [Int]
    let res = calc xs
    putStr res

has3 :: [[a]] -> Bool
has3 = any ((<=3) . length)

has2twice :: [[a]] -> Bool
has2twice = (>=2) . length . filter ((<=3) . length)

calc :: [Int] -> String
calc xs
    | canDo = "YES\n" ++ output
    | otherwise = "NO\n"
    where
        ys = zip [1..] $ xs
        zs = groupBy (on (==) snd) $ sortBy (comparing snd) ys
        res = take 3 $ findAll zs
        canDo = length res == 3
        output = unlines res

findAll :: [[(Int,Int)]] -> [String]
findAll = map fmt . ((foldr (\xs ys -> [x++y|x<-xs,y<-ys]) [[]])::[[[(Int,Int)]]]->[[(Int,Int)]]) . ((map permutations)::[[(Int,Int)]]->[[[(Int,Int)]]])

fmt :: [(Int,Int)] -> String
fmt = unwords . map show . map fst

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . unlines . getAns . getIntArray

getAns :: [Int] -> [String]
getAns (n:xs) = let anss =  gettop3 $ groupA $ zip xs [1..n]
				in if (length anss) < 3 then ["NO"] else ["YES"] ++ (map (unwords . map show)) anss

groupA :: [(Int, Int)] -> [[Int]]
groupA = map (map (\(_, x) -> x)) . groupBy (\(x, _) (y, _) -> x == y) . sort

gettop3 :: [[Int]] -> [[Int]]
gettop3 = (map concat . take 3 . mapM permutations)

import Data.List (sort, groupBy, permutations)
import Debug.Trace

solve :: [Int] -> [[Int]]
solve x =
  take 3 $ crossProduct groupings
  where
    track q = trace (show q) q
    groupings = map (map snd) . groupBy (\a -> \b -> fst a == fst b) . sort . zip x $ [1..]
    crossProduct (grouping:rst) =
      cross grouping (crossProduct rst)
    crossProduct [] = []
    cross grouping [] = permutations grouping
    cross grouping solns =
      [a ++ soln | a <- permutations grouping, soln <- solns]

showSoln :: [[Int]] -> String
showSoln x
  | length x /= 3 = "NO"
  | otherwise =
    "YES\n" ++ (unlines . map (unwords . map show) $ x)

main = do
  getLine
  putStrLn . showSoln . solve . map read . words =<< getContents

import Data.Function (on)
import Data.Functor ((<$>))
import Data.List (groupBy, inits, permutations, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> tail <$> map read <$> words <$> getContents

solve :: [Integer] -> Maybe [[Integer]]
solve = listToMaybe . drop 3 . inits . map concat . mapM (permutations . map fst)
      . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [1..]

printSolution :: Show a => Maybe [[a]] -> IO ()
printSolution xs = putStrLn (maybe "NO" (const "YES") xs)
                 >> mapM_ (putStrLn . unwords . map show) (fromMaybe [] xs)


module Main where
import Control.Monad

sign::Bool->Int->Int
sign True x
  |odd x=x+1
  |otherwise=x-1
sign False x
  |odd x=x-1
  |otherwise=x+1
pt::Int->IO()
pt=putStrLn.show

solve::Int->Bool->[IO()]
solve 1 True =[pt 2]
solve n True =(pt (sign True n)):(solve (n-1) True)

solve 1 False =[pt 1]
solve n False =(pt (sign False n)):(solve (n-1) False)
main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    list<-getLine
    let n=read list::Int
    let test=even n
    sequence$reverse (solve n test)

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t ri
    mapM_ (putStrLn.showL.solve) tcs

showL = unwords . map show

solve [n] = map (fixOrder n) [1..n]
solve _   = error "Bad input single int"

fixOrder n | (even n)   = f
           | otherwise  = g
  where
    f x | (even x)   = x-1
        | otherwise  = x+1

    g 1 = 1
    g x | (even x)   = x+1
        | otherwise  = x-1


{-# LANGUAGE ScopedTypeVariables #-}

import Prelude
import Data.Maybe
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor
import Control.Monad.ST.Safe
import Data.STRef
import qualified Data.Array.IArray as IA
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as A
import qualified Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8

solve :: Int -> Int -> [Int] -> ST s [Int]
solve n m lst = do
    cnt <- A.newArray (1, n) 0 :: ST s (A.STUArray s Int Int)
    contests <- A.newArray (1, m) 0 :: ST s (A.STUArray s Int Int)
    answer <- forM lst $ \elem -> do
        cnt_val <- A.readArray cnt elem
        A.writeArray cnt elem (cnt_val + 1)
        contests_val <- A.readArray contests (cnt_val + 1)
        A.writeArray contests (cnt_val + 1) (contests_val + 1)
        return $ if contests_val == n - 1 then 1 else 0
    return answer

main :: IO ()
main = do
    ([n, m] :: [Int]) <- (map (fst . fromJust . B8.readInt) . B8.words) <$> B8.getLine
    (arr :: [Int]) <- (map (fst . fromJust . B8.readInt) . B8.words) <$> B8.getLine
    let answer = runST $ solve n m arr
    forM_ answer $ printf "%d"
    printf "\n"

-- Codeforces Round #532 (A), Contest 1100, Problem set ?.
-- UNDONE

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  xs <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let mdn = m `div` n
  probsForRound <- A.newArray (0,mdn) n :: IO (IOUArray Int Int)
  probsWithDiff <- A.newArray (1,n) 0 :: IO (IOUArray Int Int)
  forM_ xs $ \x -> do
    px <- A.readArray probsWithDiff x
    A.writeArray probsWithDiff x (px+1)
    if px <= mdn then do
      rest <- A.readArray probsForRound px
      A.writeArray probsForRound px (rest-1)
      putChar $ if rest <= 1 then '1' else '0'
    else putChar '0'
  putStrLn ""

import Data.Array.ST.Safe
import Data.Array.IArray
import Data.STRef
import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.ST
main = putStrLn . solve . map readI . B.words =<< B.getContents
solve (n:m:as) = elems $ runSTUArray $ do
  t <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  r <- newArray_ (1,m)
  c <- newSTRef 0
  forM_ (zip [1..] as) $ \(i,a) -> do
    prev <- readArray t a
    when (prev == 0) $ modifySTRef' c succ
    writeArray t a (prev + 1)
    c' <- readSTRef c
    writeArray r i $ if c' == n then '1' else '0'
    when (c' == n) $ do
      forM_ [1..n] $ \j -> writeArray t j . pred =<< readArray t j
      writeSTRef c . length . filter (> 0) =<< getElems t
  return r
readI b = i where Just (i,_) = B.readInt b


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

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

  readInt :: String -> 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] -> String
  check xs
    | length xs < 3 = "YES"
    | length xs == 3 =
      let (a:b:c:[]) = sort xs
          in case b - a == c - b of
            True -> "YES"
            False -> "NO"

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . (map readInt) . words
    let ys = S.toList $ S.fromList xs
        ans = case length ys <= 3 of
          False -> "NO"
          True -> check ys
    putStrLn ans

import Data.List(nub,sort)
main = do
    getLine
    aaa <- return . map read . words =<< getLine
    let kinds [] _ = []
	kinds _ 4   = []
	kinds (c:cs) n	= c:remain
	      where	    remain = kinds [x| x<-cs, x/=c] $ n+1
	washed = kinds aaa 0
    case  washed 	of
      [_,_,_]		->  let	[i,j,k] = sort washed
				(half,m) = divMod (k-i) 2
			    in	if m==0 && half+i==j
				    then putStr "YES"
				    else putStr "NO"
      [_,_]		-> putStr "YES"
      [_]		-> putStr "YES"
      _			-> putStr "NO"

import Data.List

main = getContents >>= putStrLn . solve . map head . group . sort . map (read :: String -> Int) . tail . words

solve [a, b, c] = if b - a == c - b then "YES" else "NO"
solve as = if length as < 3 then "YES" else "NO"

-- ID:  714B (Filya and Homework)
-- URL: http://codeforces.com/problemset/problem/714/B

import Data.List

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    xs <- (map read . take n . words) `fmap` getContents :: IO [Int]
    putStrLn $ (judge . collect) xs

collect xs = f xs [] where
    f [] acc = Just acc
    f (x:xs) acc
        | x `elem` acc    = f xs acc
        | length acc == 3 = Nothing
        | otherwise       = f xs (x:acc)

judge Nothing = "NO"
judge (Just [x]) = "YES"
judge (Just [x,y]) = "YES"
judge (Just [x,y,z])
    | arithmeticSeq (sort [x,y,z]) = "YES"
    | otherwise = "NO"

arithmeticSeq [x,y,z]
    | y-x == z-y = True
    | otherwise  = False

import Data.List

main :: IO ()
main = output . solve [] . map read . tail . words =<< getContents

output :: Bool -> IO ()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> [Int] -> Bool
solve final [] | length final <= 2  = True
               | length final == 3 = let [a, b, c] = sort final
                                     in a + c == b + b
solve s (a:ax) | a `elem` s = solve s ax
               | length s == 3 = False
               | otherwise = solve (a:s) ax

import Data.List

main :: IO ()
main = output . solve [] . map read . tail . words =<< getContents

output :: Bool -> IO ()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> [Int] -> Bool
solve final [] | length final == 1 = True
               | length final == 2 = even ((head final) + (final !! 1))
               | length final == 3 = let [a, b, c] = sort final
                                     in a + c == b + b
solve s (a:ax) | a `elem` s = solve s ax
               | length s == 3 = False
               | otherwise = solve (a:s) ax

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

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

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

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

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

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . (map readInt) . words
    let happenable = (<=3) $ length $ S.toList $ S.fromList xs
        ans = case happenable of
                True -> "YES"
                False -> "NO"
    putStrLn ans

import Data.List(nub,sort)
main = do
    getLine
    as <- return . map read . words =<< getLine
    case sort $ nub as	of
      [x,y,z]		-> if even (z-x)
			    then putStr "YES"
			    else putStr "NO"
      [x,y]		-> if even (y-x)
			    then putStr "YES"
			    else putStr "NO"
      [x]		-> putStr "YES"
      _			-> putStr "NO"

import Data.List(nub,sort)
main = do
    getLine
    aaa <- return . map read . words =<< getLine
    let kinds [] _ = []
	kinds (c:cs) n
	  | n==4	= []
	  | otherwise	= c:(kinds [x| x<-cs, x/=c] (n+1))
	ks = kinds aaa 0
    case length ks 	of
      3		-> let	[i,j,k] = sort ks
		   in	if even (k-i)
			    then putStr "YES"
			    else putStr "NO"
      2		-> putStr "YES"
      1		-> putStr "YES"
      _		-> putStr "NO"


main = interact $ unlines . solve . lines

solve (nl:cs) = map process $ drop n cs
    where n = (read . head . words) nl
          table = foldl tolist [] $ take n cs
          tolist acc x = let ws = words x in (last ws ++ ";", head ws):acc
          process s = case lookup (last $ words s) table of Just ans -> s ++ " #" ++ ans

import qualified Data.Map as Map
import Control.Monad

f::[String]->[(String,String)]
f []=[]
f (s:strs)=let (a:b:[])=words s
           in (b++";",a):f strs

f2::[String]->Map.Map String String->[String]
f2 [] _=[]
f2 (s:strs) ms=let (a:b:[])=words s
                   Just c=Map.lookup b ms
               in (s++" #"++c):(f2 strs) ms

main = do
       e1<-getLine
       let (n:m:[])=map read (words e1)::[Int]
       e2<-replicateM n getLine
       e3<-replicateM m getLine
       let xs=f e2
       mapM_ putStrLn $ f2 e3 $ Map.fromList xs

{-# LANGUAGE ViewPatterns #-}
import Control.Monad
import qualified Data.Map.Strict as M
main = do
  [n, m] <- fmap (map read . words) getLine
  s <- M.fromList `fmap` replicateM n (fmap ((\[a, b] -> (b, a)) . words) getLine)
  replicateM m $ putStrLn . (\l -> let [_, flip M.lookup s . init -> Just n] = words l in l ++ " #" ++ n) =<< getLine


{-# LANGUAGE BangPatterns #-}

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM, forM) -- foldM est un foldl
import Data.Maybe
import Data.Int

bezout :: (Integral n) => n -> n -> (n, n)
bezout _ 0 = (1, 0)
bezout _ 1 = (0, 1)
bezout a b = (y, x-y*q)
	where
		(q, r) = a `divMod` b
		(x, y) = bezout b r

sumDigit 0 = 0
sumDigit x = mod x 10 + sumDigit (div x 10)

gcdSum :: Integer -> Integer
gcdSum x = let (a, b) = bezout x y in x*a+y*b where y = sumDigit x

solve :: Integer -> Integer
solve n
	| gcdSum n == 1 = solve (n+1)
	| otherwise = n

plotResult :: Integer -> IO ()
plotResult = print

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n

import Control.Monad

sumDigits :: Integer -> Integer
sumDigits x
    | x < 10 = x
    | otherwise = sumDigits (div x 10) + mod x 10

solve :: Integer -> Integer
solve x = if gcd x (sumDigits x) == 1 then solve (x+1) else x

main = do
    line <- getLine
    let tc = read line :: Integer
    ans <- forM_ [1..tc] (\a -> do
            line <- getLine
            let x = read line :: Integer
            print (solve x)
        )
    return ()