{-# LANGUAGE MultiWayIf #-}

module Main where
import           Prelude
import           Control.Monad
import           Data.Monoid
import qualified Data.Array                    as A
import qualified Data.Array.IO                 as AIO
import qualified Data.Array.Unboxed            as AU
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Char8         as BSC8
import           Data.Char
import           Data.List
import qualified Data.Map.Strict               as M
import           Data.Maybe
import           Data.Ord
import qualified Data.Set                      as S
import qualified Data.Vector                   as V
--import           Data.Vector.Algorithms.Search
import qualified Data.Vector.Mutable           as VM
import qualified Data.Vector.Unboxed           as VU
import qualified Data.Vector.Unboxed.Mutable   as VUM
import           Debug.Trace
--import qualified Data.Heap                     as H
import qualified Data.Sequence                 as SQ
import qualified Data.Graph.Inductive.PatriciaTree
                                               as G
import qualified Data.Graph.Inductive.Graph    as G
import           Data.Int
import           Data.Bits

main = do
  [iN, iM] <- getIL
  iSC      <- replicateM iM $ getIT2
  let sortedSC = sortBy (comparing fst) iSC

  let ret      = numbers sortedSC iN

  if ret == []
    then print (-1)
    else putStrLn $ foldl (\acc x -> acc ++ (show x)) [] ret

numbers :: [(Int, Int)] -> Int -> [Int]
numbers scs n = reverse $ reNumbers scs n 1 []

reNumbers :: [(Int, Int)] -> Int -> Int -> [Int] -> [Int]
reNumbers [] n cnt nums = if
  | cnt > n                        -> nums
  | cnt <= n && cnt == 1 && n == 1 -> reNumbers [] n (cnt + 1) (0 : nums)
  | cnt <= n && cnt == 1 && n /= 1 -> reNumbers [] n (cnt + 1) (1 : nums)
  | cnt <= n && cnt /= 1           -> reNumbers [] n (cnt + 1) (0 : nums)

reNumbers (sc : scs) n cnt nums = if
  | cnt > n -> nums
  | fst sc == cnt && fst sc == 1 && snd sc == 0 && n /= 1 -> []
  | fst sc == cnt -> reNumbers scs n (cnt + 1) (snd sc : nums)
  | fst sc < cnt && head nums == snd sc -> reNumbers scs n cnt nums
  | fst sc < cnt && head nums /= snd sc -> []
  | cnt == 1 && n /= 1 -> reNumbers (sc : scs) n (cnt + 1) (1 : nums)
  | otherwise -> reNumbers (sc : scs) n (cnt + 1) (0 : nums)

{-
hMaxPoint :: Int
hMaxPoint = 101
hMaximum :: H.Heap Int -> Int
hMaximum h = hMaxPoint - (H.minimum h)
hInsertMax :: Int -> H.Heap Int -> H.Heap Int
hInsertMax x = H.insert (hMaxPoint - x)
hDeleteMax :: H.Heap Int -> H.Heap Int
hDeleteMax = H.deleteMin
-}

{-
aroundSquare y x h w =
  [ aYX
  | aYX@(aY, aX) <- [(y - 1, x), (y, x - 1), (y + 1, x), (y, x + 1), (y, x)]
  , aY >= 0
  , aY <= (h - 1)
  , aX >= 0
  , aX <= (w - 1)
  ]
-}

splitReadBSC8 :: BSC8.ByteString -> [Int]
splitReadBSC8 bs =
  let (bs1, newBs) = BSC8.splitAt 1 bs
  in  if newBs == BSC8.empty
        then [test $ BSC8.readInt bs1]
        else (test $ BSC8.readInt bs1) : (splitReadBSC8 newBs)
  where test (Just (i, _)) = i

read2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> IO Char
read2DimChar vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x
write2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> Char -> IO ()
write2DimChar vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

readTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> IO Int
readTwoDimVec vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x
writeTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> Int -> IO ()
writeTwoDimVec vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

getVUI :: IO (VU.Vector Int)
getVUI = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

getRepVUI :: Int -> IO (VU.Vector Int)
getRepVUI n =
  VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace)
    .   BSC8.unlines
    <$> replicateM n BSC8.getLine

getVS :: IO (V.Vector Char)
getVS = V.fromList <$> getLine

getVUC :: IO (VU.Vector Char)
getVUC = VU.fromList <$> getLine

readI :: BSC8.ByteString -> Int
readI = fst . fromJust . BSC8.readInt

readIL :: BSC8.ByteString -> [Int]
readIL = map readI . BSC8.words

readIT2 :: BSC8.ByteString -> (Int, Int)
readIT2 bs =
  let words = BSC8.words bs in (readI $ head words, readI $ last words)

getI :: IO Int
getI = readI <$> BSC8.getLine

getIL :: IO [Int]
getIL = readIL <$> BSC8.getLine

getIT2 :: IO (Int, Int)
getIT2 = readIT2 <$> BSC8.getLine

getIT2Order :: IO (Int, Int)
getIT2Order =
  getIL >>= \x@[xz, xo] -> if xz > xo then return (xo, xz) else return (xz, xo)

getNIS :: Int -> IO [(Int, BSC8.ByteString)]
getNIS 0 = return []
getNIS n = do
  [aFst, aSnd] <- BSC8.words <$> BSC8.getLine
  next         <- getNIS (n - 1)
  return ((readI aFst, aSnd) : next)

il2Words :: [Int] -> String
il2Words = unwords . map show

il2Lines :: [Int] -> String
il2Lines = unlines . map show

p :: Int -> Int
p x = x - 1

--modNum = 10 ^ 9 + 7
--modulus = 1000000007
modulus = 2019

newtype MInt = M Int

instance Num MInt where
  (M a) + (M b) = M $ mod (a + b) modulus

  (M a) - (M b) = M $ mod (a - b) modulus

  (M a) * (M b) = M $ mod (a * b) modulus

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = M $ abs a

  signum (M a) = M $ signum a

instance Show MInt where
  show (M a) = show (mod a modulus)

int2MInt :: Int -> MInt
int2MInt a = M (mod a modulus)

mInt2Int :: MInt -> Int
mInt2Int (M a) = a

{-
factsMod :: V.Vector MInt
factsMod = V.scanl (\acc x -> M x * acc) 1 $ V.generate 2000000 (+ 1)

factMod :: Int -> MInt
factMod = (factsMod V.!)
-}

factMod :: Int -> MInt
factMod n | n == 0    = 1
          | n == 1    = 1
          | otherwise = M n * (factMod (n - 1))

factDivMod :: Int -> Int -> MInt
factDivMod n k | n == k    = M 1
               | otherwise = M n * (factDivMod (n - 1) k)

powMod :: MInt -> MInt -> MInt
powMod n mK@(M k) | k == 0       = M 1
                  | k == 1       = n
                  | mod k 2 == 0 = powMod (n ^ 2) (M (div k 2))
                  | otherwise    = n * powMod (n ^ 2) (M (div k 2))

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x     = powMod x (M (modulus - 2))

{-
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | otherwise = factMod n * invMod (factMod (n - k)) * invMod (factMod k)
-}
combiMod :: Int -> Int -> MInt
combiMod n k | n < 0 || k < 0 || k > n = 0
             | k > n - k = factDivMod n k * invMod (factMod (n - k))
             | otherwise = factDivMod n (n - k) * invMod (factMod k)

combi :: Int -> Int -> Int
combi n k | n < 0 || k < 0 || k > n = 0
          | k == n                  = 1
          | otherwise               = div (div (fact n) (fact (n - k))) (fact k)

primes :: Integral a => [a]
primes = map fromIntegral $ [2, 3] ++ primes'
 where
  primes' = [5] ++ f 1 7 primes'
  f m s (p : ps) = [ n | n <- ns, gcd m n == 1 ] ++ f (m * p) (p * p) ps
    where ns = [ x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4] ]

fact :: Int -> Int
fact 0         = 1
fact n | n > 0 = n * fact (n - 1)

knappsack :: Int -> [(Int, Int)] -> VU.Vector Int
knappsack maxW [] = VU.replicate (maxW + 1) 0
knappsack maxW ((w, v) : xs) =
  let tailDP = knappsack maxW xs
  in  VU.generate (maxW + 1) $ \i -> if w <= i
        then max (tailDP VU.! i) (tailDP VU.! (i - w) + v)
        else tailDP VU.! i

knappsackMaxVal
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> IO Int
knappsackMaxVal dp volumeVec valueVec dpSize = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if v < volume
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v - volume)
            dpIV  <- AIO.readArray dp (i, v)
            return (max (dpIVm + value) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      [0 .. dpSize]
    )
    [0 .. VU.length volumeVec - 1]
  AIO.readArray dp (VU.length volumeVec, dpSize)

knappsackMinVol
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> Int
  -> IO Int
knappsackMinVol dp volumeVec valueVec dpSize maxVolume = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if (v + value) > dpSize
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v + value)
            dpIV  <- AIO.readArray dp (i, v)
            return (min (dpIVm - volume) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      (reverse [0 .. dpSize])
    )
    [0 .. VU.length valueVec - 1]
  foldM
    (\acc x -> do
      num <- AIO.readArray dp (VU.length volumeVec, x)
      return $ if num <= maxVolume then x else acc
    )
    0
    [0 .. dpSize]

lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (VU.Vector Int)
lcsTable xs ys = V.scanl step (VU.replicate (m + 1) 0) xs'
 where
  n   = BS.length xs
  m   = BS.length ys
  xs' = V.generate n $ BSC8.index xs :: V.Vector Char
  ys' = VU.generate m $ BSC8.index ys :: VU.Vector Char
  step :: VU.Vector Int -> Char -> VU.Vector Int
  step v x = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
   where
    innerStep :: Int -> (Int, Int, Char) -> Int
    innerStep a (b, c, y) | x == y    = 1 + b
                          | otherwise = max a c
{-
main = do
xs <- BS.getLine
ys <- BS.getLine
print $ VU.last $ V.last $ lcsTable xs ys
-}

myFilter :: (a -> Bool) -> [a] -> ([a], [a])
myFilter _pred [] = ([], [])
myFilter pred (x : xs)
  | pred x    = let (l, r) = myFilter pred xs in (x : l, r)
  | otherwise = let (l, r) = myFilter pred xs in (l, x : r)

--UnionFindデータ構造
type UF_PARENT = VUM.IOVector Int
type UF_RANK = VUM.IOVector Int
type UF = (UF_PARENT, UF_RANK)
uf_makeSet :: Int -> IO UF
uf_makeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank   <- VUM.replicate n 0
  return (parent, rank)
uf_union :: UF -> Int -> Int -> IO ()
uf_union unionFind@(parents, ranks) x y = do
  xRoot     <- uf_find unionFind x
  yRoot     <- uf_find unionFind y
  xRootRank <- VUM.read ranks xRoot
  yRootRank <- VUM.read ranks yRoot
  if
    | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
    | xRootRank < yRootRank -> VUM.write parents xRoot yRoot
    | xRoot /= yRoot -> do
      VUM.write parents yRoot xRoot
      VUM.write ranks xRoot (xRootRank + 1)
    | otherwise -> return ()

uf_find :: UF -> Int -> IO Int
uf_find unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- uf_find unionFind xParent
      VUM.write parents x xRootParent
      return xRootParent

--UnDirectedGraph(無向グラフ)データ構造
type UDG = M.Map Int [Int]
list2UDG :: [(Int, Int)] -> M.Map Int [Int]
list2UDG = foldl
  (\acc x ->
    let lr = M.insertWith (++) (fst x) [snd x] acc
    in  M.insertWith (++) (snd x) [fst x] lr
  )
  M.empty


{-# LANGUAGE MultiWayIf #-}

module Main where
import           Prelude
import           Control.Monad
import           Data.Monoid
import qualified Data.Array                    as A
import qualified Data.Array.IO                 as AIO
import qualified Data.Array.Unboxed            as AU
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Char8         as BSC8
import           Data.Char
import           Data.List
import qualified Data.Map.Strict               as M
import           Data.Maybe
import           Data.Ord
import qualified Data.Set                      as S
import qualified Data.Vector                   as V
--import           Data.Vector.Algorithms.Search
import qualified Data.Vector.Mutable           as VM
import qualified Data.Vector.Unboxed           as VU
import qualified Data.Vector.Unboxed.Mutable   as VUM
import           Debug.Trace
--import qualified Data.Heap                     as H
import qualified Data.Sequence                 as SQ
import qualified Data.Graph.Inductive.PatriciaTree
                                               as G
import qualified Data.Graph.Inductive.Graph    as G
import           Data.Int
import           Data.Bits

main = do
  [iN, iM] <- getIL
  iSC      <- replicateM iM $ getIT2
  let sortedSC = sortBy (comparing fst) iSC

  let ret      = numbers sortedSC iN

  if ret == []
    then print (-1)
    else putStrLn $ foldl (\acc x -> acc ++ (show x)) [] $reverse ret

numbers :: [(Int, Int)] -> Int -> [Int]
numbers scs n = reNumbers scs n 1 []

reNumbers :: [(Int, Int)] -> Int -> Int -> [Int] -> [Int]
reNumbers []         _ _   nums = nums
reNumbers (sc : scs) n cnt nums = if
  | fst sc == cnt && fst sc == 1 && snd sc == 0 -> []
  | fst sc == cnt -> reNumbers scs n (cnt + 1) (snd sc : nums)
  | fst sc < cnt && head nums == snd sc -> reNumbers scs n cnt nums
  | fst sc < cnt && head nums /= snd sc -> []
  | cnt == 1 && n /= 1 -> reNumbers (sc : scs) n (cnt + 1) (1 : nums)
  | otherwise -> reNumbers (sc : scs) n (cnt + 1) (0 : nums)

{-
hMaxPoint :: Int
hMaxPoint = 101
hMaximum :: H.Heap Int -> Int
hMaximum h = hMaxPoint - (H.minimum h)
hInsertMax :: Int -> H.Heap Int -> H.Heap Int
hInsertMax x = H.insert (hMaxPoint - x)
hDeleteMax :: H.Heap Int -> H.Heap Int
hDeleteMax = H.deleteMin
-}

{-
aroundSquare y x h w =
  [ aYX
  | aYX@(aY, aX) <- [(y - 1, x), (y, x - 1), (y + 1, x), (y, x + 1), (y, x)]
  , aY >= 0
  , aY <= (h - 1)
  , aX >= 0
  , aX <= (w - 1)
  ]
-}

splitReadBSC8 :: BSC8.ByteString -> [Int]
splitReadBSC8 bs =
  let (bs1, newBs) = BSC8.splitAt 1 bs
  in  if newBs == BSC8.empty
        then [test $ BSC8.readInt bs1]
        else (test $ BSC8.readInt bs1) : (splitReadBSC8 newBs)
  where test (Just (i, _)) = i

read2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> IO Char
read2DimChar vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x
write2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> Char -> IO ()
write2DimChar vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

readTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> IO Int
readTwoDimVec vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x
writeTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> Int -> IO ()
writeTwoDimVec vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

getVUI :: IO (VU.Vector Int)
getVUI = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

getRepVUI :: Int -> IO (VU.Vector Int)
getRepVUI n =
  VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace)
    .   BSC8.unlines
    <$> replicateM n BSC8.getLine

getVS :: IO (V.Vector Char)
getVS = V.fromList <$> getLine

getVUC :: IO (VU.Vector Char)
getVUC = VU.fromList <$> getLine

readI :: BSC8.ByteString -> Int
readI = fst . fromJust . BSC8.readInt

readIL :: BSC8.ByteString -> [Int]
readIL = map readI . BSC8.words

readIT2 :: BSC8.ByteString -> (Int, Int)
readIT2 bs =
  let words = BSC8.words bs in (readI $ head words, readI $ last words)

getI :: IO Int
getI = readI <$> BSC8.getLine

getIL :: IO [Int]
getIL = readIL <$> BSC8.getLine

getIT2 :: IO (Int, Int)
getIT2 = readIT2 <$> BSC8.getLine

getIT2Order :: IO (Int, Int)
getIT2Order =
  getIL >>= \x@[xz, xo] -> if xz > xo then return (xo, xz) else return (xz, xo)

getNIS :: Int -> IO [(Int, BSC8.ByteString)]
getNIS 0 = return []
getNIS n = do
  [aFst, aSnd] <- BSC8.words <$> BSC8.getLine
  next         <- getNIS (n - 1)
  return ((readI aFst, aSnd) : next)

il2Words :: [Int] -> String
il2Words = unwords . map show

il2Lines :: [Int] -> String
il2Lines = unlines . map show

p :: Int -> Int
p x = x - 1

--modNum = 10 ^ 9 + 7
--modulus = 1000000007
modulus = 2019

newtype MInt = M Int

instance Num MInt where
  (M a) + (M b) = M $ mod (a + b) modulus

  (M a) - (M b) = M $ mod (a - b) modulus

  (M a) * (M b) = M $ mod (a * b) modulus

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = M $ abs a

  signum (M a) = M $ signum a

instance Show MInt where
  show (M a) = show (mod a modulus)

int2MInt :: Int -> MInt
int2MInt a = M (mod a modulus)

mInt2Int :: MInt -> Int
mInt2Int (M a) = a

{-
factsMod :: V.Vector MInt
factsMod = V.scanl (\acc x -> M x * acc) 1 $ V.generate 2000000 (+ 1)

factMod :: Int -> MInt
factMod = (factsMod V.!)
-}

factMod :: Int -> MInt
factMod n | n == 0    = 1
          | n == 1    = 1
          | otherwise = M n * (factMod (n - 1))

factDivMod :: Int -> Int -> MInt
factDivMod n k | n == k    = M 1
               | otherwise = M n * (factDivMod (n - 1) k)

powMod :: MInt -> MInt -> MInt
powMod n mK@(M k) | k == 0       = M 1
                  | k == 1       = n
                  | mod k 2 == 0 = powMod (n ^ 2) (M (div k 2))
                  | otherwise    = n * powMod (n ^ 2) (M (div k 2))

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x     = powMod x (M (modulus - 2))

{-
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | otherwise = factMod n * invMod (factMod (n - k)) * invMod (factMod k)
-}
combiMod :: Int -> Int -> MInt
combiMod n k | n < 0 || k < 0 || k > n = 0
             | k > n - k = factDivMod n k * invMod (factMod (n - k))
             | otherwise = factDivMod n (n - k) * invMod (factMod k)

combi :: Int -> Int -> Int
combi n k | n < 0 || k < 0 || k > n = 0
          | k == n                  = 1
          | otherwise               = div (div (fact n) (fact (n - k))) (fact k)

primes :: Integral a => [a]
primes = map fromIntegral $ [2, 3] ++ primes'
 where
  primes' = [5] ++ f 1 7 primes'
  f m s (p : ps) = [ n | n <- ns, gcd m n == 1 ] ++ f (m * p) (p * p) ps
    where ns = [ x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4] ]

fact :: Int -> Int
fact 0         = 1
fact n | n > 0 = n * fact (n - 1)

knappsack :: Int -> [(Int, Int)] -> VU.Vector Int
knappsack maxW [] = VU.replicate (maxW + 1) 0
knappsack maxW ((w, v) : xs) =
  let tailDP = knappsack maxW xs
  in  VU.generate (maxW + 1) $ \i -> if w <= i
        then max (tailDP VU.! i) (tailDP VU.! (i - w) + v)
        else tailDP VU.! i

knappsackMaxVal
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> IO Int
knappsackMaxVal dp volumeVec valueVec dpSize = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if v < volume
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v - volume)
            dpIV  <- AIO.readArray dp (i, v)
            return (max (dpIVm + value) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      [0 .. dpSize]
    )
    [0 .. VU.length volumeVec - 1]
  AIO.readArray dp (VU.length volumeVec, dpSize)

knappsackMinVol
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> Int
  -> IO Int
knappsackMinVol dp volumeVec valueVec dpSize maxVolume = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if (v + value) > dpSize
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v + value)
            dpIV  <- AIO.readArray dp (i, v)
            return (min (dpIVm - volume) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      (reverse [0 .. dpSize])
    )
    [0 .. VU.length valueVec - 1]
  foldM
    (\acc x -> do
      num <- AIO.readArray dp (VU.length volumeVec, x)
      return $ if num <= maxVolume then x else acc
    )
    0
    [0 .. dpSize]

lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (VU.Vector Int)
lcsTable xs ys = V.scanl step (VU.replicate (m + 1) 0) xs'
 where
  n   = BS.length xs
  m   = BS.length ys
  xs' = V.generate n $ BSC8.index xs :: V.Vector Char
  ys' = VU.generate m $ BSC8.index ys :: VU.Vector Char
  step :: VU.Vector Int -> Char -> VU.Vector Int
  step v x = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
   where
    innerStep :: Int -> (Int, Int, Char) -> Int
    innerStep a (b, c, y) | x == y    = 1 + b
                          | otherwise = max a c
{-
main = do
xs <- BS.getLine
ys <- BS.getLine
print $ VU.last $ V.last $ lcsTable xs ys
-}

myFilter :: (a -> Bool) -> [a] -> ([a], [a])
myFilter _pred [] = ([], [])
myFilter pred (x : xs)
  | pred x    = let (l, r) = myFilter pred xs in (x : l, r)
  | otherwise = let (l, r) = myFilter pred xs in (l, x : r)

--UnionFindデータ構造
type UF_PARENT = VUM.IOVector Int
type UF_RANK = VUM.IOVector Int
type UF = (UF_PARENT, UF_RANK)
uf_makeSet :: Int -> IO UF
uf_makeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank   <- VUM.replicate n 0
  return (parent, rank)
uf_union :: UF -> Int -> Int -> IO ()
uf_union unionFind@(parents, ranks) x y = do
  xRoot     <- uf_find unionFind x
  yRoot     <- uf_find unionFind y
  xRootRank <- VUM.read ranks xRoot
  yRootRank <- VUM.read ranks yRoot
  if
    | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
    | xRootRank < yRootRank -> VUM.write parents xRoot yRoot
    | xRoot /= yRoot -> do
      VUM.write parents yRoot xRoot
      VUM.write ranks xRoot (xRootRank + 1)
    | otherwise -> return ()

uf_find :: UF -> Int -> IO Int
uf_find unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- uf_find unionFind xParent
      VUM.write parents x xRootParent
      return xRootParent

--UnDirectedGraph(無向グラフ)データ構造
type UDG = M.Map Int [Int]
list2UDG :: [(Int, Int)] -> M.Map Int [Int]
list2UDG = foldl
  (\acc x ->
    let lr = M.insertWith (++) (fst x) [snd x] acc
    in  M.insertWith (++) (snd x) [fst x] lr
  )
  M.empty

Global OOD problem IDs are disjoint from train, validation, and in-distribution test problem IDs.

Score : 300 points

Problem Statement

If there is an integer not less than 0 satisfying the following conditions, print the smallest such integer; otherwise, print -1.

The integer has exactly N digits in base ten. (We assume 0 to be a 1-digit integer. For other integers, leading zeros are not allowed.)

The s_i-th digit from the left is c_i. \left(i = 1, 2, \cdots, M\right)

Constraints

All values in input are integers.

1 \leq N \leq 3

0 \leq M \leq 5

1 \leq s_i \leq N

0 \leq c_i \leq 9

Input

Input is given from Standard Input in the following format:

N M
s_1 c_1
\vdots
s_M c_M

Output

Print the answer.

Sample Input 1

3 3
1 7
3 2
1 7

Sample Output 1

702

702 satisfies the conditions - its 1-st and 3-rd digits are 7 and 2, respectively - while no non-negative integer less than 702 satisfies them.

Sample Input 2

3 2
2 1
2 3

Sample Output 2

-1

Sample Input 3

3 1
1 0

Sample Output 3

-1

Submitted source-code file size, in bytes.

Execution CPU time reported by official Project CodeNet metadata, in milliseconds.

Peak memory usage reported by official Project CodeNet metadata, in kilobytes.


import Data.Char
import Control.Monad

parseInputLine :: String -> String -> [Int]
parseInputLine val [] = [read val]
parseInputLine val (' ':xs) = [read val] ++ parseInputLine "" xs
parseInputLine val (x:xs) = parseInputLine (val ++ [x]) xs

solve :: String -> [[Int]] -> Int
solve str []
  | length str >= 2 && all (== '0') str = -1
  | read str == 0 = -1
  | c == '0' = read ('1':drop 1 str)
  | otherwise = read str
  where c = head str
solve str (sc:scs) = if r `elem` ['0', chr (ord '0' + c)]
                        then solve new_str scs
                        else -1
  where s = sc!!0 - 1
        c = sc!!1
        r = str!!s
        new_str = (take s str) ++ (show c) ++ (drop (s+1) str)

main :: IO ()
main = do
  inNM <- getLine
  let nm = parseInputLine "" inNM
      n = nm!!0
      m = nm!!1
  inScs <- replicateM m getLine
  let scs = map (parseInputLine "") inScs
      initStr = take n (repeat '0')
      output = solve initStr scs

  putStrLn (show output)


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[ n, m ] <- readInts
	[ ss, cs ] <- transpose . ( [ 0, -1 ] : ) <$> replicateM m readInts
	print $ fromMaybe (-1) $ listToMaybe $ do
		i <- [ 1 .. 1000 ]
		let
			str = map digitToInt $ show i
		guard $ length str == n && maximum ss <= length str && check ( map pred ss ) cs str
		return i

check ss cs str = runST $ do
	res <- newSTRef True
	forM_ ( zip ss cs ) $ \( s, c ) -> do
		modifySTRef res ( && ( c == -1 || ( str !! s ) == c ) )
	readSTRef res


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[ n, m ] <- readInts
	[ ss, cs ] <- transpose <$> replicateM m readInts
	print $ fromMaybe (-1) $ listToMaybe $ do
		i <- [ 1 .. 1000 ]
		let
			str = map digitToInt $ show i
		guard $ length str == n && maximum ss <= length str && check ( map pred ss ) cs str
		return i

check ss cs str = runST $ do
	res <- newSTRef True
	forM_ ( zip ss cs ) $ \( s, c ) -> do
		modifySTRef res ( && ( str !! s ) == c )
	readSTRef res


import Control.Monad
main=do
 [n,m]<-map read.words<$>getLine
 i<-replicateM m$(\[s,c]->(\a->a!!((read s)-1)==(c!!0))).words<$>getLine
 let j=(+(10^(n-1)))$length$takeWhile(\a->not$all(id)$map(\f->f a)i)[b|b<-map show[0..1000],length b==n]
 print$if j==(10^n)then(-1)else j


import Control.Monad
import Data.List

main = do
  li <- getLine
  let [n,m] = map read $ words li
  scs <- forM [1..m] (\_ -> do
    li <- getLine
    let [s,c] = map read $ words li
    return (s,c)
    )
  let ans = compute n scs
  print ans

compute :: Int -> [(Int,Int)] -> Int
compute n scs = inner n
  where
    [c1,c2,c3] = [ nub $ findAll i scs | i <- [1..3] ]
    dig d c = if null c then d else head c
    d1 = dig 1 c1
    d2 = dig 0 c2
    d3 = dig 0 c3
    inner _ | bad c1 || bad c2 || bad c3 = -1
    inner 1 = dig 0 c1
    inner _ | d1 == 0 = -1
    inner 2 = d1 * 10 + d2
    inner 3 = d1 * 100 + d2 * 10 + d3

findAll x kvs = [ v | (k,v) <- kvs, x == k ]

bad []  = False
bad [_] = False
bad  _  = True


import Control.Monad
import Data.List

main = do
  li <- getLine
  let [n,m] = map read $ words li
  scs <- forM [1..m] (\_ -> do
    li <- getLine
    let [s,c] = map read $ words li
    return (s,c)
    )
  let ans = compute n scs
  print ans

compute :: Int -> [(Int,Int)] -> Int
compute n scs
  | not (ok c1) = -1
  | d1 == 0 = -1
  | otherwise = inner n
  where
    [c1,c2,c3] = [ nub $ findAll i scs | i <- [1..3] ]
    ok c = null c || singleton c
    d1 = head (c1 ++ [1])
    d2 = head (c2 ++ [0])
    d3 = head (c3 ++ [0])
    inner 1 | null c2 && null c3 = d1
    inner 2 | ok c2 && null c3 = d1 * 10 + d2
    inner 3 | ok c2 && ok c3 = d1 * 100 + d2 * 10 + d3
    inner _ = -1

findAll _ [] = []
findAll x ((y,z):yzs)
  | x == y = z : findAll x yzs
  | True   = findAll x yzs

singleton [_] = True
singleton _ = False


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

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
listToTuple (x : y : _) = (x, y)

main = do
    [n, m] <- getIntList
    scs <- sort . map listToTuple <$> replicateM m getIntList
    let ns = f n
    let ans = [n | n <- ns, and $ map (\(s, c) -> (show n) !! (s - 1) == head (show c)) scs]
    if null ans then print (-1) else print $ head ans

f n | n == 1 = [0..9]
    | n == 2 = [10..99]
    | n == 3 = [100..999]


import qualified Data.IntMap as M
import Data.Maybe
import Data.List

import Debug.Trace
_t x = traceShow x x

concatIntList :: Integral a => [a] -> a
concatIntList xs = go (length xs - 1) xs 0
  where
    go _ [] sum     = sum
    go n (x:xs) sum = go (n-1) xs (sum + x * 10^n)

solve :: Int -> [(Int,Int)] -> Int
solve n sc = maybe (-1) go2 $ go sc M.empty
  where
    go [] m = Just m
    go ((i,v):xs) m
      | n >= 2 && i == 1 && v == 0 = Nothing
      | otherwise =
          case M.lookup i m of
              Nothing -> go xs (M.insert i v m)
              Just vv -> if vv == v
                           then go xs (M.insert i v m) else Nothing
    go2 m = let l = map (\i -> fromMaybe 0 (M.lookup i m)) [1..n]
             in rep0 l
    rep0 xs = let (s1,s2) = span (==0) xs
                  ss = if n == 1
                          then [0]
                          else (1 : replicate (length s1 - 1) 0) ++ s2
               in case s1 of
                   [] -> concatIntList xs
                   otherwise -> concatIntList ss

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine :: IO [Int]
    sc <- map ((\[a,b] -> (a,b)) . (map read . words))
        . lines <$> getContents :: IO [(Int,Int)]
    print $ solve n sc


import qualified Data.IntMap as M
import Data.Maybe
import Data.List

concatIntList :: Integral a => [a] -> a
concatIntList xs = go (length xs - 1) xs 0
  where
    go _ [] sum     = sum
    go n (x:xs) sum = go (n-1) xs (sum + x * 10^n)

solve :: Int -> [(Int,Int)] -> Int
solve n sc = maybe (-1) go2 $ go sc M.empty
  where
    go [] m = Just m
    go ((i,v):xs) m =
        case M.lookup i m of
            Nothing -> go xs (M.insert i v m)
            Just vv -> if vv == v
                         then go xs (M.insert i v m) else Nothing
    go2 m = let l = map (\i -> fromMaybe 0 (M.lookup i m)) [1..n]
             in rep0 l
    rep0 xs = let (s1,s2) = span (==0) xs
               in case s1 of
                   [] -> concatIntList xs
                   otherwise -> -1

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine :: IO [Int]
    sc <- map ((\[a,b] -> (a,b)) . (map read . words))
        . lines <$> getContents :: IO [(Int,Int)]
    print $ solve n sc


import qualified Data.IntMap as M
import Data.Maybe
import Data.List

concatIntList :: Integral a => [a] -> a
concatIntList xs = go (length xs - 1) xs 0
  where
    go _ [] sum     = sum
    go n (x:xs) sum = go (n-1) xs (sum + x * 10^n)

solve :: Int -> [(Int,Int)] -> Int
solve n sc = maybe (-1) go2 $ go sc M.empty
  where
    go [] m = Just m
    go ((i,v):xs) m =
        case M.lookup i m of
            Nothing -> go xs (M.insert i v m)
            Just vv -> if vv == v
                         then go xs (M.insert i v m) else Nothing
    go2 m = let l = map (\i -> fromMaybe 0 (M.lookup i m)) [1..n]
                gl = group l
             in concatIntList . concat $ map (const 1) (head gl) : tail gl

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine :: IO [Int]
    sc <- map ((\[a,b] -> (a,b)) . (map read . words))
        . lines <$> getContents :: IO [(Int,Int)]
    print $ solve n sc


import qualified Data.IntMap as M
import Data.Maybe
import Data.List

concatIntList :: Integral a => [a] -> a
concatIntList xs = go (length xs - 1) xs 0
  where
    go _ [] sum     = sum
    go n (x:xs) sum = go (n-1) xs (sum + x * 10^n)

solve :: Int -> [(Int,Int)] -> Maybe Int
solve n sc = maybe Nothing f $ go sc M.empty
  where
    go [] m = Just m
    go ((i,v):xs) m =
        case M.lookup i m of
            Nothing -> go xs (M.insert i v m)
            Just vv -> if vv == v
                          then go xs (M.insert i v m) else Nothing
    f m = let l = map (\i -> fromMaybe 0 (M.lookup i m)) [1..n]
              gl = group l
              dl = concat $ drop 0 gl
           in if head (head gl) == 0
                 then Just . concatIntList. concat $ (map (\p -> 1) (head gl) : tail gl)
                 else Just $ concatIntList dl

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine :: IO [Int]
    sc <- map ((\[a,b] -> (a,b)) . (map read . words))
        . lines <$> getContents :: IO [(Int,Int)]
    print $ fromMaybe (-1) $ solve n sc


import qualified Data.Map as MP
import Data.Char
import Data.List
import Control.Monad

toTuple [a,b] = (a,b)

parse :: Int -> [Int]
parse x = map digitToInt $ show x

solve :: Int -> [(Int, Int)] -> Int -> Int
solve n xs i
    | i > 1000 = -1
    | (length p) /= n = solve n xs (i+1)
    | not search = solve n xs (i+1)
    | otherwise = i
    where
        p = parse i
        search = foldl' (\b sc -> step p b sc) True xs
        step p b (s,c) = b && (p !! (s-1) == c)

main = do
   [n,m] <- map read . words <$> getLine :: IO [Int]
   xs <- replicateM m (toTuple . map read . words <$> getLine) :: IO [(Int,Int)]
   print $ solve n xs 0


module Main where

import Data.List
import Control.Monad
import Debug.Trace
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)
import qualified Data.Set  as S
import qualified Data.IntMap.Strict as IM
import Data.Char

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as = let
    (fo, la) = span f as
    las = case la of
        [] -> []
        xs -> split f $ tail xs
    in
        case fo of
            [] -> las
            xs -> xs : las

solve :: Int -> [(Int, Int)] -> String
solve n m =
    let
        nums = show <$> [10 ^ (n - 1)..(10 ^ n - 1)]
        takeKeta keta num
            | keta > n = Nothing
            | otherwise =  Just $ digitToInt $ num !! (keta - 1)
        satisfy number = all (\(keta, num) -> takeKeta keta number == Just num) m
        ans = filter satisfy nums
    in
    case ans of
        [] -> "-1"
        (x:xs) -> x

main = do
    (n, m) <- readTuple2
    conds <- replicateM m readTuple2
    putStrLn $ solve n conds


import qualified Data.IntMap as M
import Data.Maybe
import Data.List

concatIntList :: Integral a => [a] -> a
concatIntList xs = go (length xs - 1) xs 0
  where
    go _ [] sum     = sum
    go n (x:xs) sum = go (n-1) xs (sum + x * 10^n)

solve :: Int -> [(Int,Int)] -> Maybe Int
solve n sc = maybe Nothing f $ go sc M.empty
  where
    go [] m = Just m
    go ((i,v):xs) m =
        case M.lookup i m of
            Nothing -> go xs (M.insert i v m)
            Just vv -> if vv == v
                          then go xs (M.insert i v m) else Nothing
    f m = let l = map (\i -> fromMaybe 0 (M.lookup i m)) [1..n]
              gl = group l
              dl = drop 0 gl
           in if head (head gl) == 0
                 then Nothing
                 else Just . concatIntList $ concat dl

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine :: IO [Int]
    sc <- map ((\[a,b] -> (a,b)) . (map read . words))
        . lines <$> getContents :: IO [(Int,Int)]
    print $ fromMaybe (-1) $ solve n sc


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE BangPatterns #-}

-- Default Imports

import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans.Class

import qualified Control.Monad.Reader as Reader
import Control.Monad.Reader (Reader, ReaderT, runReader, runReaderT)

import qualified Data.Array.MArray as MArray
import qualified Data.Array.ST as STArray
import Data.Array.ST (STArray, STUArray, runSTArray, runSTUArray)
import Data.Ix (Ix)

import qualified Data.Bits as Bits
import Data.Bits ((.&.), (.|.))

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)

import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as GVector
import qualified Data.Vector.Mutable as MVector
import Data.Vector.Mutable (STVector)
import qualified Data.Vector.Unboxed as UVector

import Data.STRef

import Numeric

import Debug.Trace
-- ----------

-- Custom Import Here

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

-- Default Definitions

type Vector = Vector.Vector
-- type GVector = GVector.Vector
type UVector = UVector.Vector

readIntToList :: ByteString -> [Int]
readIntToList = List.unfoldr (fmap (second $ BS.dropWhile Char.isSpace) . BS.readInt)

readToList :: Read a => ByteString -> [a]
readToList = List.unfoldr $ fmap (mapTaken . mapRemain) . span' (not . Char.isSpace)
	where
		mapTaken  = first $ read . BS.unpack
		mapRemain = second $ BS.dropWhile Char.isSpace
		span' pred s
			| BS.null taken = Nothing
			| otherwise     = Just (taken, remain')
			where
				(taken, remain) = BS.span pred s
				remain' = BS.dropWhile Char.isSpace remain

readToListN :: Read a => Int -> ByteString -> [a]
readToListN n = take n . readToList

readIntToVector :: ByteString -> Vector Int
readIntToVector = Vector.unfoldr (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToUVector :: ByteString -> UVector.Vector Int
readIntToUVector = UVector.unfoldr (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToVectorN :: Int -> ByteString -> Vector.Vector Int
readIntToVectorN n = Vector.unfoldrN n (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToUVectorN :: Int -> ByteString -> UVector.Vector Int
readIntToUVectorN n = UVector.unfoldrN n (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

first :: (a -> a') -> (a, b) -> (a', b)
first f (a, b) = (f a, b)

second :: (b -> b') -> (a, b) -> (a, b')
second f (a, b) = (a, f b)

average :: Fractional a => [a] -> a
average xs = sum xs / (fromIntegral . length) xs

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

toTuple [a, b] = (a, b)

(??) = flip Maybe.fromMaybe

check :: [Int] -> Maybe [Int]
check digs
	| length digs == 1 = Just digs
	| head digs == 0 = Nothing
	| otherwise = Just digs

fill :: Int -> [Maybe Int] -> Maybe [Int]
fill n digs = check $ flip map (zip [0..] digs) $ \(i, dig) ->
	dig ?? if n /= 1 && i == 0 then 1 else 0

main :: IO ()
main = do
	[n, m] <- readIntToList <$> BS.getLine
	scs <- replicateM m $ toTuple . readIntToList <$> BS.getLine
	let (digs, ok) = runST $ do
		ok <- newSTRef True
		digs <- MVector.replicate n Nothing
		forM_ scs $ \(s, c) -> do
			dig <- MVector.read digs (s - 1)
			case dig of
				Nothing -> MVector.write digs (s - 1) $ Just c
				Just c' -> if c == c'
					then return ()
					else writeSTRef ok False
		digs' <- Vector.freeze digs
		ok' <- readSTRef ok
		return (digs', ok')
	let result = fill n (Vector.toList digs)
	if ok
		then case result of
			Just r -> putStrLn $ concat $ map show r
			Nothing -> putStrLn "-1"
		else putStrLn "-1"


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE BangPatterns #-}

-- Default Imports

import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans.Class

import qualified Control.Monad.Reader as Reader
import Control.Monad.Reader (Reader, ReaderT, runReader, runReaderT)

import qualified Data.Array.MArray as MArray
import qualified Data.Array.ST as STArray
import Data.Array.ST (STArray, STUArray, runSTArray, runSTUArray)
import Data.Ix (Ix)

import qualified Data.Bits as Bits
import Data.Bits ((.&.), (.|.))

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)

import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as GVector
import qualified Data.Vector.Mutable as MVector
import Data.Vector.Mutable (STVector)
import qualified Data.Vector.Unboxed as UVector

import Numeric

import Debug.Trace
-- ----------

-- Custom Import Here

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

-- Default Definitions

type Vector = Vector.Vector
-- type GVector = GVector.Vector
type UVector = UVector.Vector

readIntToList :: ByteString -> [Int]
readIntToList = List.unfoldr (fmap (second $ BS.dropWhile Char.isSpace) . BS.readInt)

readToList :: Read a => ByteString -> [a]
readToList = List.unfoldr $ fmap (mapTaken . mapRemain) . span' (not . Char.isSpace)
	where
		mapTaken  = first $ read . BS.unpack
		mapRemain = second $ BS.dropWhile Char.isSpace
		span' pred s
			| BS.null taken = Nothing
			| otherwise     = Just (taken, remain')
			where
				(taken, remain) = BS.span pred s
				remain' = BS.dropWhile Char.isSpace remain

readToListN :: Read a => Int -> ByteString -> [a]
readToListN n = take n . readToList

readIntToVector :: ByteString -> Vector Int
readIntToVector = Vector.unfoldr (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToUVector :: ByteString -> UVector.Vector Int
readIntToUVector = UVector.unfoldr (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToVectorN :: Int -> ByteString -> Vector.Vector Int
readIntToVectorN n = Vector.unfoldrN n (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

readIntToUVectorN :: Int -> ByteString -> UVector.Vector Int
readIntToUVectorN n = UVector.unfoldrN n (fmap stripRemain . BS.readInt)
	where stripRemain = second $ BS.dropWhile Char.isSpace

first :: (a -> a') -> (a, b) -> (a', b)
first f (a, b) = (f a, b)

second :: (b -> b') -> (a, b) -> (a, b')
second f (a, b) = (a, f b)

average :: Fractional a => [a] -> a
average xs = sum xs / (fromIntegral . length) xs

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

toTuple [a, b] = (a, b)

(??) = flip Maybe.fromMaybe

check :: [Int] -> Maybe [Int]
check digs
	| length digs == 1 = Just digs
	| head digs == 0 = Nothing
	| otherwise = Just digs

fill :: Int -> [Maybe Int] -> Maybe [Int]
fill n digs = check $ flip map (zip [0..] digs) $ \(i, dig) ->
	dig ?? if n /= 1 && i == 0 then 1 else 0

main :: IO ()
main = do
	[n, m] <- readIntToList <$> BS.getLine
	scs <- replicateM m $ toTuple . readIntToList <$> BS.getLine
	let digs = runST $ do
		digs <- MVector.replicate n Nothing
		forM_ scs $ \(s, c) -> do
			dig <- MVector.read digs (s - 1)
			case dig of
				Nothing -> MVector.write digs (s - 1) $ Just c
				Just c' -> if c == c'
					then return ()
					else MVector.write digs 0 $ Just 0
		Vector.freeze digs
	let result = fill n (Vector.toList digs)
	case result of
		Just r -> putStrLn $ concat $ map show r
		Nothing -> putStrLn "-1"


import qualified Data.ByteString.Char8 as B
import Data.Char
import Control.Monad
readInput :: Read a => IO [a]
readInput = map read . words <$> getLine

main = do
    [n, m] <- readInput
    constraints <- replicateM m readInput
    case [ i | i <- [0..999]
        , let str = B.pack $ show (i :: Int)
        , B.length str == n
        , all (\[s, c] -> str `B.index` pred s == intToDigit c) constraints
        ] of
            [] -> print (-1)
            i : _ -> print i


import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
import Data.List (sort, tails)

main :: IO ()
main = do
  (n : k : _) <- map unsafeTextToInt . T.words <$> T.getLine :: IO [Int]
  as <- sort . map unsafeTextToInt . T.words <$> T.getLine :: IO [Int]
  let
    ps = mergeAll $ zipWith f as (tail . tails $ as)
  print $ ps !! pred k

merge :: [Int] -> [Int] -> [Int]
merge xs [] = xs
merge [] ys = ys
merge xs@(x : xs') ys@(y : ys') | y < x     = y : merge xs ys'
                                | otherwise = x : merge xs' ys

merges :: [[Int]] -> [[Int]]
merges (xs : xs' : xss) = merge xs xs' : merges xss
merges xss = xss

mergeAll :: [[Int]] -> [Int]
mergeAll [] = []
mergeAll (xs : []) = xs
mergeAll xss = mergeAll . merges $ xss

f :: Int -> [Int] -> [Int]
f a as | a < 0     = map (a *) . reverse $ as
       | otherwise = map (a *) as

{-
f :: [Int] -> Int
f = f' (- 10 ^ 18 - 1) (10 ^ 18 + 1)
  where
    f' x y | succ x == y = y
           | p m         = f' x m
           | otherwise   = f' m y
      where
        m = (x + y) `div` 2
    p = (k <=) . g

-}

unsafeTextToInt :: T.Text -> Int
unsafeTextToInt s = case T.signed T.decimal s of
  Right (n, _) -> n

Score: 400 points

Problem Statement

We have N integers A_1, A_2, ..., A_N.

There are \frac{N(N-1)}{2} ways to choose two of them and form a pair. If we compute the product of each of those pairs and sort the results in ascending order, what will be the K-th number in that list?

Constraints

All values in input are integers.

2 \leq N \leq 2 \times 10^5

1 \leq K \leq \frac{N(N-1)}{2}

-10^9 \leq A_i \leq 10^9\ (1 \leq i \leq N)

Input

Input is given from Standard Input in the following format:

N K
A_1 A_2 \dots A_N

Output

Print the answer.

Sample Input 1

4 3
3 3 -4 -2

Sample Output 1

-6

There are six ways to form a pair. The products of those pairs are 9, -12, -6, -12, -6, 8.

Sorting those numbers in ascending order, we have -12, -12, -6, -6, 8, 9. The third number in this list is -6.

Sample Input 2

10 40
5 4 3 2 -1 0 0 0 0 0

Sample Output 2

6

Sample Input 3

30 413
-170202098 -268409015 537203564 983211703 21608710 -443999067 -937727165 -97596546 -372334013 398994917 -972141167 798607104 -949068442 -959948616 37909651 0 886627544 -20098238 0 -948955241 0 -214720580 277222296 -18897162 834475626 0 -425610555 110117526 663621752 0

Sample Output 3

448283280358331064


import Data.Maybe
solve :: [Int] -> Maybe Int
solve [a,b]
 | ((a > 9) || (b > 9)) = Nothing
 | otherwise = return $ a * b
main = do
 print =<< (fromMaybe (-1)) . solve . map read . words <$> getLine

Score : 100 points

Problem Statement

Having learned the multiplication table, Takahashi can multiply two integers between 1 and 9 (inclusive) together. He cannot do any other calculation.

Given are two integers A and B.

If Takahashi can calculate A \times B, print the result; if he cannot, print -1 instead.

Constraints

1 \leq A \leq 20

1 \leq B \leq 20

All values in input are integers.

Input

Input is given from Standard Input in the following format:

A B

Output

If Takahashi can calculate A \times B, print the result; if he cannot, print -1.

Sample Input 1

2 5

Sample Output 1

10

2 \times 5 = 10.

Sample Input 2

5 10

Sample Output 2

-1

5\times 10 = 50, but Takahashi cannot do this calculation, so print -1 instead.

Sample Input 3

9 9

Sample Output 3

81


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

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

main = do
    [a, b] <- getIntList
    print $ solve a b

solve a b | a < 10 && b < 10 = a * b
          | otherwise = -1


main=do
 [a,b]<-map read.words<$>getLine
 print$if a>9||b>9 then-1 else a*b


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

readInts :: IO [Int]
readInts = map read . words <$> getLine

solve [a, b]
  | a < 10 && b < 10 = a * b
  | otherwise = -1

main = solve <$> readInts >>= print


solve :: Integer -> Integer -> Integer
solve a b
    | a > 9 = -1
    | b > 9 = -1
    | otherwise = a*b

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


main = do
    l <- map read . words <$> getLine
    print $ solve (l!!0,l!!1)

solve :: (Int, Int) -> Int
solve (a,b)
    | a>9 = -1
    | b>9 = -1
    | otherwise = a * b


main :: IO ()
main = do
  l1 <- getLine
  let [a, b] = map read $ words l1 :: [Int]
  print $ if a <= 9 && b <= 9 then a*b else -1


import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

main :: IO ()
main = do
  (a : b : _) <- map unsafeSignedDecimal . T.words <$> T.getLine :: IO [Int]
  print $ if a <= 9 && b <= 9 then a * b else (-1)

unsafeSignedDecimal :: T.Text -> Int
unsafeSignedDecimal s = case T.signed T.decimal s of
  Right (n, _) -> n


import qualified Data.ByteString.Char8 as BS
import Data.Maybe

readInt = fromIntegral . fst . fromJust . BS.readInteger

readString = map BS.unpack . BS.words

getInt = readInt <$> BS.getLine

getString = readString <$> BS.getLine

calc :: String -> Char -> Int -> Int
calc [] c k = 0
calc [c'] c k
  | c == c' = k - 1
  | otherwise = 0
calc s c k
  | c' == c'' = k + calc s'' c k
  | otherwise = calc s' c k
  where
    c' = head s
    s' = tail s
    c'' = head s'
    s'' = tail s'

main = do
  [s] <- getString
  k <- getInt
  print $ calc s (head s) k

Score : 300 points

Problem Statement

Given is a string S. Let T be the concatenation of K copies of S.
We can repeatedly perform the following operation: choose a character in T and replace it with a different character.
Find the minimum number of operations required to satisfy the following condition: any two adjacent characters in T are different.

Constraints

1 \leq |S| \leq 100

S consists of lowercase English letters.

1 \leq K \leq 10^9

K is an integer.

Input

Input is given from Standard Input in the following format:

S
K

Output

Print the minimum number of operations required.

Sample Input 1

issii
2

Sample Output 1

4

T is issiiissii. For example, we can rewrite it into ispiqisyhi, and now any two adjacent characters are different.

Sample Input 2

qq
81

Sample Output 2

81

Sample Input 3

cooooooooonteeeeeeeeeest
999993333

Sample Output 3

8999939997


--{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE ScopedTypeVariables #-}
--{-# LANGUAGE FlexibleContexts #-}
--{-# LANGUAGE ViewPatterns #-}
--{-# LANGUAGE OverloadedStrings #-}
--{-# LANGUAGE Strict #-}
--{-# LANGUAGE NumericUnderscores #-}
--{-# LANGUAGE BlockArguments #-}
--{-# LANGUAGE MultiWayIf #-}

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as MP
import qualified Data.Map.Strict as MPS
import qualified Data.Set as ST
import qualified Data.Sequence as SQ
-- import Data.Array
import Data.Array.Unboxed
-- import Data.Array.ST
-- import Data.Array.IO
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Char
import Data.Bits
import Data.List
import Data.Tuple
import Data.Functor
import Data.IORef
import Data.STRef
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
-- import qualified Data.Vector.Algorithms.Merge as VAM
-- import qualified Data.Heap as HP
-- import Numeric.Extra
-- import Data.Tuple.Extra
-- import Data.List.Extra

--------------------------------------------------------------------------
scan [] = 0
scan [_] = 0
scan(x:y:xs)
    | x == y = 1 + scan ('?':xs)
    | otherwise = scan (y:xs)

main = do
    xs <- str
    k <- int
    let
        a = scan $ xs ++ xs
        b = scan $ xs ++ xs ++ xs
        d = b - a

    print $
        case all (==head xs) xs of
            True -> (length xs * k) `div` 2
            False -> a + (k-1) * d
--------------------------------------------------------------------------

-- Input Util
int :: IO Int
int = BC.getLine >>= return . bsToInt

double :: IO Double
double = BC.getLine >>= return . bsToDouble

str :: IO String
str = BC.getLine >>= return . BC.unpack

strBS :: IO BC.ByteString
strBS = BC.getLine

-- convert
bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

bsToDouble :: BC.ByteString -> Double
bsToDouble = read . BC.unpack

bsToIntTuple :: BC.ByteString -> (Int, Int)
bsToIntTuple bs = (a,b)
    where
        Just (a,bs') = parseInt bs
        Just (b,_) = parseInt bs'

bsToIntTriple :: BC.ByteString -> (Int, Int, Int)
bsToIntTriple bs = (a,b,c)
    where
        Just (a,bs') = parseInt bs
        Just (b,bs'') = parseInt bs'
        Just (c,_) = parseInt bs''

parseInt :: BC.ByteString -> Maybe (Int, BC.ByteString)
parseInt = BC.readInt . BC.dropWhile isSpace

-- single line
fromSLineL :: (BC.ByteString -> a) -> IO [a]
fromSLineL f = strBS >>= return . map f . BC.words

-- from single line to List / VU.Vector
sLineToIntL :: IO [Int]
sLineToIntL = fromSLineL bsToInt

sLineToDoubleL :: IO [Double]
sLineToDoubleL = fromSLineL bsToDouble

sLineToStrL :: IO [String]
sLineToStrL = fromSLineL BC.unpack

sLineToStrBSL :: IO [BC.ByteString]
sLineToStrBSL = fromSLineL id

sLineToIntV :: Int -> IO (VU.Vector Int)
sLineToIntV n = BC.getLine >>= return . VU.unfoldrN n parseInt

sLineToDoubleV :: IO (VU.Vector Double)
sLineToDoubleV = BC.getLine >>= return . VU.fromList . map bsToDouble . BC.words

-- multiple lines
fromMLinesL :: Int -> (BC.ByteString -> a) -> IO [a]
fromMLinesL n f = replicateM n (strBS >>= return . f)

fromMLinesV :: VU.Unbox a => Int -> (BC.ByteString -> a) -> IO (VU.Vector a)
fromMLinesV n f = VU.replicateM n (strBS >>= return . f)

-- from multiple lines to List / VU.Vector
mLinesToIntL :: Int -> IO [Int]
mLinesToIntL n = fromMLinesL n bsToInt

mLinesToDoubleL :: Int -> IO [Double]
mLinesToDoubleL n = fromMLinesL n bsToDouble

mLinesToStrL :: Int -> IO [String]
mLinesToStrL n = fromMLinesL n BC.unpack

mLinesToStrBSL :: Int -> IO [BC.ByteString]
mLinesToStrBSL n = fromMLinesL n id

mLinesToTupleL :: Int -> IO [(Int, Int)]
mLinesToTupleL n = fromMLinesL n bsToIntTuple

mLinesToTripleL :: Int -> IO [(Int, Int, Int)]
mLinesToTripleL n = fromMLinesL n bsToIntTriple

mLinesToIntV :: Int -> IO (VU.Vector Int)
mLinesToIntV n = fromMLinesV n bsToInt

mLinesToDoubleV :: Int -> IO (VU.Vector Double)
mLinesToDoubleV n = fromMLinesV n bsToDouble

mLinesToTupleV :: Int -> IO (VU.Vector (Int, Int))
mLinesToTupleV n = fromMLinesV n bsToIntTuple

mLinesToTripleV :: Int -> IO (VU.Vector (Int, Int, Int))
mLinesToTripleV n = fromMLinesV n bsToIntTriple

-- output
yesnoL :: Bool -> IO ()
yesnoL cond
    | cond = putStrLn "Yes"
    | otherwise = putStrLn "No"

yesnoU :: Bool -> IO ()
yesnoU cond
    | cond = putStrLn "YES"
    | otherwise = putStrLn "NO"

-- others
strToChr :: String -> Char
strToChr [x] = x

chrToStr :: Char -> String
chrToStr x = [x]

m1 :: Int -> Int
m1 x = subtract 1 x

toDouble :: Int -> Double
toDouble x = fromIntegral x

toInt :: Double -> Int
toInt x = floor x

sqToList :: SQ.Seq a -> [a]
sqToList sq =
    case SQ.viewl sq of
        SQ.EmptyL -> []
        x SQ.:< sq' -> x : sqToList sq'


--{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE ScopedTypeVariables #-}
--{-# LANGUAGE FlexibleContexts #-}
--{-# LANGUAGE ViewPatterns #-}
--{-# LANGUAGE OverloadedStrings #-}
--{-# LANGUAGE Strict #-}
--{-# LANGUAGE NumericUnderscores #-}
--{-# LANGUAGE BlockArguments #-}
--{-# LANGUAGE MultiWayIf #-}

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as MP
import qualified Data.Set as ST
import qualified Data.Sequence as SQ
import Data.Array
import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.IO
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Char
import Data.Bits
import Data.List
import Data.Tuple
import Data.Functor
import Data.IORef
import Data.STRef
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
-- import qualified Data.Vector.Algorithms.Merge as VAM
-- import qualified Data.Heap as HP
-- import Numeric.Extra
-- import Data.Tuple.Extra
-- import Data.List.Extra

--------------------------------------------------------------------------
f :: String -> Int
f [] = 0
f [_] = 0
f (x:y:xs)
    | x == y = 1 + f xs
    | otherwise = f (y:xs)

g xs
    | b == c = 0
    | a == c = 1
    | otherwise = 0
    where
        a = head xs
        b = xs !! (length xs - 2)
        c = last xs

main = do
    xs <- str
    k <- int
    let
        base = f xs
        add = g xs
    print $
        if length xs  == 1
            then length xs `div` 2
            else base * k + (if add == 0 then 0 else add * k - 1)
--------------------------------------------------------------------------

-- Input Util
int :: IO Int
int = BC.getLine >>= return . bsToInt

double :: IO Double
double = BC.getLine >>= return . bsToDouble

str :: IO String
str = BC.getLine >>= return . BC.unpack

strBS :: IO BC.ByteString
strBS = BC.getLine

-- convert
bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

bsToDouble :: BC.ByteString -> Double
bsToDouble = read . BC.unpack

bsToIntTuple :: BC.ByteString -> (Int, Int)
bsToIntTuple bs = (a,b)
    where
        Just (a,bs') = parseInt bs
        Just (b,_) = parseInt bs'

bsToIntTriple :: BC.ByteString -> (Int, Int, Int)
bsToIntTriple bs = (a,b,c)
    where
        Just (a,bs') = parseInt bs
        Just (b,bs'') = parseInt bs'
        Just (c,_) = parseInt bs''

parseInt :: BC.ByteString -> Maybe (Int, BC.ByteString)
parseInt = BC.readInt . BC.dropWhile isSpace

-- single line
fromSLineL :: (BC.ByteString -> a) -> IO [a]
fromSLineL f = strBS >>= return . map f . BC.words

-- from single line to List / VU.Vector
sLineToIntL :: IO [Int]
sLineToIntL = fromSLineL bsToInt

sLineToDoubleL :: IO [Double]
sLineToDoubleL = fromSLineL bsToDouble

sLineToStrL :: IO [String]
sLineToStrL = fromSLineL BC.unpack

sLineToStrBSL :: IO [BC.ByteString]
sLineToStrBSL = fromSLineL id

sLineToIntV :: Int -> IO (VU.Vector Int)
sLineToIntV n = BC.getLine >>= return . VU.unfoldrN n parseInt

sLineToDoubleV :: IO (VU.Vector Double)
sLineToDoubleV = BC.getLine >>= return . VU.fromList . map bsToDouble . BC.words

-- multiple lines
fromMLinesL :: Int -> (BC.ByteString -> a) -> IO [a]
fromMLinesL n f = replicateM n (strBS >>= return . f)

fromMLinesV :: VU.Unbox a => Int -> (BC.ByteString -> a) -> IO (VU.Vector a)
fromMLinesV n f = VU.replicateM n (strBS >>= return . f)

-- from multiple lines to List / VU.Vector
mLinesToIntL :: Int -> IO [Int]
mLinesToIntL n = fromMLinesL n bsToInt

mLinesToDoubleL :: Int -> IO [Double]
mLinesToDoubleL n = fromMLinesL n bsToDouble

mLinesToStrL :: Int -> IO [String]
mLinesToStrL n = fromMLinesL n BC.unpack

mLinesToStrBSL :: Int -> IO [BC.ByteString]
mLinesToStrBSL n = fromMLinesL n id

mLinesToTupleL :: Int -> IO [(Int, Int)]
mLinesToTupleL n = fromMLinesL n bsToIntTuple

mLinesToTripleL :: Int -> IO [(Int, Int, Int)]
mLinesToTripleL n = fromMLinesL n bsToIntTriple

mLinesToIntV :: Int -> IO (VU.Vector Int)
mLinesToIntV n = fromMLinesV n bsToInt

mLinesToDoubleV :: Int -> IO (VU.Vector Double)
mLinesToDoubleV n = fromMLinesV n bsToDouble

mLinesToTupleV :: Int -> IO (VU.Vector (Int, Int))
mLinesToTupleV n = fromMLinesV n bsToIntTuple

mLinesToTripleV :: Int -> IO (VU.Vector (Int, Int, Int))
mLinesToTripleV n = fromMLinesV n bsToIntTriple

-- output
yesnoL :: Bool -> IO ()
yesnoL cond
    | cond = putStrLn "Yes"
    | otherwise = putStrLn "No"

yesnoU :: Bool -> IO ()
yesnoU cond
    | cond = putStrLn "YES"
    | otherwise = putStrLn "NO"

-- others
strToChr :: String -> Char
strToChr [x] = x

chrToStr :: Char -> String
chrToStr x = [x]

m1 :: Int -> Int
m1 x = subtract 1 x

toDouble :: Int -> Double
toDouble x = fromIntegral x

toInt :: Double -> Int
toInt x = floor x


solve :: String -> Int -> Int
solve s k
  | even n    = f s * k
  | otherwise = let (d,r) = k `divMod` 2
                   in (f s * 2 + 1) * d + r * f s
  where
    n = length s
    f []  = 0
    f [_] = 0
    f (x1:x2:xs)
      | x1 == x2  = 1 + f xs
      | otherwise = f (x2:xs)

main :: IO ()
main = do
    s <- getLine
    k <- readLn :: IO Int
    print $ solve s k


edist' :: Char -> String -> (Int, Bool)
edist' h (x:[]) = (0, h == x)
edist' h (x:x':[])
	| x == x'   = (1, False)
	| otherwise = (0, False)
edist' h (x:x':xs)
	| x == x'   = let (n, l) = edist' h xs in (n + 1, l)
	| otherwise = edist' h (x':xs)

looped xs = head xs == last xs

edist :: String -> Int -> Int
edist xs k = k * n + if l then k - 1 else 0
	where (n, l) = edist' (head xs) xs

main :: IO ()
main = do
	xs <- getLine
	k <- readLn
	print $ edist xs k


import Control.Monad
import Data.List
insertionsort :: (Ord a) => [a] -> [a]
insertionsort = foldr insert []

inner 0 xs     = sum xs
inner m (x:xs) = inner (m-1) $ sortBy (\x y->compare y x) ((div x 2):xs)

main = do
 [n,m] <- map read . words <$> getLine :: IO [Int]
 a <- sortBy (\x y-> compare y x) . map read . words <$> getLine :: IO [Int]
 print $ inner m a

Score : 400 points

Problem Statement

Takahashi is going to buy N items one by one.

The price of the i-th item he buys is A_i yen (the currency of Japan).

He has M discount tickets, and he can use any number of them when buying an item.

If Y tickets are used when buying an item priced X yen, he can get the item for \frac{X}{2^Y} (rounded down to the nearest integer) yen.

What is the minimum amount of money required to buy all the items?

Constraints

All values in input are integers.

1 \leq N, M \leq 10^5

1 \leq A_i \leq 10^9

Input

Input is given from Standard Input in the following format:

N M
A_1 A_2 ... A_N

Output

Print the minimum amount of money required to buy all the items.

Sample Input 1

3 3
2 13 8

Sample Output 1

9

We can buy all the items for 9 yen, as follows:

Buy the 1-st item for 2 yen without tickets.

Buy the 2-nd item for 3 yen with 2 tickets.

Buy the 3-rd item for 4 yen with 1 ticket.

Sample Input 2

4 4
1 9 3 5

Sample Output 2

6

Sample Input 3

1 100000
1000000000

Sample Output 3

0

We can buy the item priced 1000000000 yen for 0 yen with 100000 tickets.

Sample Input 4

10 1
1000000000 1000000000 1000000000 1000000000 1000000000 1000000000 1000000000 1000000000 1000000000 1000000000

Sample Output 4

9500000000


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Data.Bool
import qualified Data.ByteString             as B
import qualified Data.ByteString.Builder     as B
import qualified Data.ByteString.Char8       as C
import qualified Data.ByteString.Internal    as B
import qualified Data.ByteString.Unsafe      as B
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import qualified Data.IntMap.Strict          as IM
import qualified Data.IntSet                 as IS
import qualified Data.List                   as L
import qualified Data.Map.Strict             as M
import           Data.Monoid
import           Data.Ord
import           Data.Primitive.MutVar
import qualified Data.Set                    as S
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Debug.Trace
import           Foreign                     hiding (void)
import           GHC.Exts
import qualified System.IO                   as IO
import           Unsafe.Coerce

main :: IO ()
main = do
    [n,m] <- map read.words <$> getLine :: IO [Int]
    xs <- U.unfoldrN n parseInt <$> C.getLine
    print $ solve n m xs

solve :: Int -> Int -> U.Vector Int -> Int
solve n m xs = go m . fromList $ U.toList xs
  where
    go 0 !h = sum $ toList h
    go !acc !h = case _HHdeleteFindMax h of
        Just (x, h') -> go (acc - 1) $ _HHinsert (quot x 2) h'
        Nothing -> undefined

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

data MaxHeap a = MaxFork !a [MaxHeap a] | MaxEmpty

_HHempty :: MaxHeap a
_HHempty = MaxEmpty
{-# INLINE _HHempty #-}

_HHsingleton :: a -> MaxHeap a
_HHsingleton = flip MaxFork []
{-# INLINE _HHsingleton #-}

_HHnull :: MaxHeap a -> Bool
_HHnull (MaxFork _ _) = False
_HHnull MaxEmpty      = True
{-# INLINE _HHnull #-}

_HHinsert :: Ord a => a -> MaxHeap a -> MaxHeap a
_HHinsert = _HHmerge . _HHsingleton
{-# INLINE _HHinsert #-}

_HHMaxElem :: MaxHeap a -> Maybe a
_HHMaxElem (MaxFork x _) = Just x
_HHMaxElem MaxEmpty      = Nothing
{-# INLINE _HHMaxElem #-}

_HHdeleteMax :: Ord a => MaxHeap a -> Maybe (MaxHeap a)
_HHdeleteMax (MaxFork _ hs) = Just $! _HHmergePairs hs
_HHdeleteMax MaxEmpty       = Nothing
{-# INLINE _HHdeleteMax #-}

_HHdeleteFindMax :: Ord a => MaxHeap a -> Maybe (a, MaxHeap a)
_HHdeleteFindMax (MaxFork x hs) = case _HHmergePairs hs of
    merged -> Just $! (x, merged)
_HHdeleteFindMax MaxEmpty       = Nothing
{-# INLINE _HHdeleteFindMax #-}

_HHmerge :: Ord a => MaxHeap a -> MaxHeap a -> MaxHeap a
_HHmerge hx@(MaxFork x hxs) hy@(MaxFork y hys)
  | y <= x    = MaxFork x (hy:hxs)
  | otherwise = MaxFork y (hx:hys)
_HHmerge MaxEmpty hy = hy
_HHmerge hx MaxEmpty = hx
{-# INLINE _HHmerge #-}

_HHmergePairs :: Ord a => [MaxHeap a] -> MaxHeap a
_HHmergePairs = go . mergePairs
  where
    mergePairs (x:y:xs) = case x <> y of
        merged -> merged : mergePairs xs
    mergePairs xs = xs

    go hs@(_:_:_) = go $ mergePairs hs
    go [h] = h
    go [] = MaxEmpty
{-# INLINE _HHmergePairs #-}

instance Ord a => Eq (MaxHeap a) where
    (==) = (==) `on` toList

instance Ord a => Ord (MaxHeap a) where
    compare = compare `on` toList

instance Ord a => IsList (MaxHeap a) where
    type Item (MaxHeap a) = a
    fromList xs = _HHmergePairs $ map _HHsingleton xs
    toList = L.unfoldr _HHdeleteFindMax

instance (Show a, Ord a) => Show (MaxHeap a) where
    show = show . toList

instance Ord a => Monoid (MaxHeap a) where
    mempty = _HHempty
    {-# INLINE mempty #-}
    mappend = _HHmerge
    {-# INLINE mappend #-}

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = runStateT $
    (,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = runStateT $
    (,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt4 :: Parser (Int, Int, Int, Int)
parseInt4 = runStateT $
    (,,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Data.Bool
import qualified Data.ByteString             as B
import qualified Data.ByteString.Builder     as B
import qualified Data.ByteString.Char8       as C
import qualified Data.ByteString.Internal    as B
import qualified Data.ByteString.Unsafe      as B
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import qualified Data.IntMap.Strict          as IM
import qualified Data.IntSet                 as IS
import qualified Data.List                   as L
import qualified Data.Map.Strict             as M
import           Data.Monoid
import           Data.Ord
import           Data.Primitive.MutVar
import qualified Data.Set                    as S
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Debug.Trace
import           Foreign                     hiding (void)
import           GHC.Exts
import qualified System.IO                   as IO
import           Unsafe.Coerce

main :: IO ()
main = do
    [n,m] <- map read.words <$> getLine :: IO [Int]
    xs <- U.unfoldrN n parseInt <$> C.getLine
    print $ solve n m xs

solve :: Int -> Int -> U.Vector Int -> Int
solve n m xs = go m $ U.foldl' (flip _HHinsert) mempty xs
  where
    go 0 h = sum $ toList h
    go acc h = case _HHdeleteFindMax h of
        Just (x, h') -> go (acc - 1) $ _HHinsert (quot x 2) h'
        Nothing -> undefined

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

data MaxHeap a = MaxFork !a [MaxHeap a] | MaxEmpty

_HHempty :: MaxHeap a
_HHempty = MaxEmpty
{-# INLINE _HHempty #-}

_HHsingleton :: a -> MaxHeap a
_HHsingleton = flip MaxFork []
{-# INLINE _HHsingleton #-}

_HHnull :: MaxHeap a -> Bool
_HHnull (MaxFork _ _) = False
_HHnull MaxEmpty      = True
{-# INLINE _HHnull #-}

_HHinsert :: Ord a => a -> MaxHeap a -> MaxHeap a
_HHinsert = _HHmerge . _HHsingleton
{-# INLINE _HHinsert #-}

_HHMaxElem :: MaxHeap a -> Maybe a
_HHMaxElem (MaxFork x _) = Just x
_HHMaxElem MaxEmpty      = Nothing
{-# INLINE _HHMaxElem #-}

_HHdeleteMax :: Ord a => MaxHeap a -> Maybe (MaxHeap a)
_HHdeleteMax (MaxFork _ hs) = Just $! _HHmergePairs hs
_HHdeleteMax MaxEmpty       = Nothing
{-# INLINE _HHdeleteMax #-}

_HHdeleteFindMax :: Ord a => MaxHeap a -> Maybe (a, MaxHeap a)
_HHdeleteFindMax (MaxFork x hs) = case _HHmergePairs hs of
    merged -> Just $! (x, merged)
_HHdeleteFindMax MaxEmpty       = Nothing
{-# INLINE _HHdeleteFindMax #-}

_HHmerge :: Ord a => MaxHeap a -> MaxHeap a -> MaxHeap a
_HHmerge hx@(MaxFork x hxs) hy@(MaxFork y hys)
  | y <= x    = MaxFork x (hy:hxs)
  | otherwise = MaxFork y (hx:hys)
_HHmerge MaxEmpty hy = hy
_HHmerge hx MaxEmpty = hx
{-# INLINE _HHmerge #-}

_HHmergePairs :: Ord a => [MaxHeap a] -> MaxHeap a
_HHmergePairs = mconcat . mergePairs
  where
    mergePairs (x:y:xs) = case x <> y of
        merged -> merged : mergePairs xs
    mergePairs xs = xs
{-# INLINE _HHmergePairs #-}

instance Ord a => Eq (MaxHeap a) where
    (==) = (==) `on` toList

instance Ord a => Ord (MaxHeap a) where
    compare = compare `on` toList

instance Ord a => IsList (MaxHeap a) where
    type Item (MaxHeap a) = a
    fromList xs = _HHmergePairs $ map _HHsingleton xs
    toList = L.unfoldr _HHdeleteFindMax

instance (Show a, Ord a) => Show (MaxHeap a) where
    show = show . toList

instance Ord a => Monoid (MaxHeap a) where
    mempty = _HHempty
    {-# INLINE mempty #-}
    mappend = _HHmerge
    {-# INLINE mappend #-}

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = runStateT $
    (,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = runStateT $
    (,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt4 :: Parser (Int, Int, Int, Int)
parseInt4 = runStateT $
    (,,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)


{-# LANGUAGE OverloadedStrings #-}
import Prelude hiding (null, elem)
import Control.Monad
import Data.Char
import Data.List hiding (insert, null, elem)
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  [n, m] <- getIntList
  queue <- fromList <$> getIntList
  print $ solve m queue

solve :: Int -> Heap Int -> Int
solve m queue
  | m == 0 = sum . toList $ queue
  | otherwise = solve (m - 1) . uncurry insert . mapFst (`div`2) . deleteFindMax $ queue

mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f (a, b) = (f a, b)

-- Leftist Heap
data Heap a =
  Empty |
  Heap {
    rank :: Int,
    elem :: a,
    left :: Heap a,
    right ::Heap a}

empty :: Heap a
empty = Empty

null :: Heap a -> Bool
null Empty = True
null (Heap _ _ _ _) = False

singleton :: a -> Heap a
singleton x = Heap 1 x Empty Empty

merge :: Ord a => Heap a -> Heap a -> Heap a
merge h     Empty = h
merge Empty h     = h
merge h1 h2
  | elem h1 > elem h2 = makeHeap (elem h1) (left h1) (merge (right h1) h2)
  | otherwise = makeHeap (elem h2) (left h2) (merge (right h2) h1)

makeHeap :: a -> Heap a -> Heap a -> Heap a
makeHeap x a b =
  if ra >= rb then Heap (rb + 1) x a b else Heap (ra + 1) x b a
  where
    rb = if null b then 0 else rank b
    ra = if null a then 0 else rank a

insert :: Ord a => a -> Heap a -> Heap a
insert x h = merge (singleton x) h

deleteFindMax :: Ord a => Heap a -> (a, Heap a)
deleteFindMax Empty = error "Empty Heap"
deleteFindMax (Heap _ x a b) = (x, merge a b)

fromList :: Ord a => [a] -> Heap a
fromList = foldl (flip insert) Empty

toList :: Ord a => Heap a -> [a]
toList h
  | null h = []
  | otherwise = let (x, h') = deleteFindMax h
                in x : toList h'
-- IO
readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt

getInt :: IO Int
getInt = readInt <$> BS.getLine

getIntList :: IO [Int]
getIntList = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine


import Data.List

main = do
  li <- getLine
  let [n,m] = map read $ words li
  li <- getLine
  let as = map read $ words li
  let ans = compute n m as
  print ans

compute :: Int -> Int -> [Int] -> Int
compute n m as = sum (ass !! m)
  where
    as0 = sortBy c as
    ass = iterate f as0

c = flip compare
f (a:as) = insertBy c (div a 2) as

{-
最大のものを取り出し、半分にし、戻す。
という作業をM回繰り返し、残った値の和が答え。

最大のものが簡単に取り出せるヒープのようなデータ構造を使うべき問題だ。
sortBy, insertBy で間に合うだろうか？
-}


-- https://github.com/minoki/my-atcoder-solutions
import Data.Char (isSpace)
import Data.Int (Int64)
import Data.List (unfoldr)
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap.Strict as IntMap
import Data.Monoid

discount :: Int -> IntMap.IntMap Int -> IntMap.IntMap Int
discount 0 p = p
discount m p = case IntMap.maxViewWithKey p of
                  Nothing -> p
                  Just ((k, l), p')
                    | m < l -> IntMap.insertWith (+) (k `quot` 2) m $ IntMap.insert k (l - m) p'
                    | otherwise -> discount (m - l) $ IntMap.insertWith (+) (k `quot` 2) l p'

main = do
  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  p <- IntMap.fromListWith (+) . map (\x -> (x,1)) . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  let result :: Int64
      result = getSum $ IntMap.foldMapWithKey (\k l -> Sum $! fromIntegral k * fromIntegral l) $ discount m p
  print result


import           Control.Monad
import qualified Control.Monad.ST            as ST
import           Data.Array.IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Maybe
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

rollingHash :: BS.ByteString -> Int -> (V.Vector Word, V.Vector Word)
rollingHash s b = ST.runST $ do
  let sz = BS.length s
      b' = fromIntegral b
  h <- VM.new (sz+1)
  VM.write h 0 (0::Word)
  power <- VM.new (sz+1)
  VM.write power 0 (1::Word)
  forM_ [0..(sz-1)] $ \i -> do
    powi <- VM.read power i
    VM.write power (i+1) (powi * b')
    hi <- VM.read h i
    let si = fromIntegral $ ord $ BS.index s i
    VM.write h (i+1) (hi * b' + si)
  h' <- V.freeze h
  power' <- V.freeze power
  return (h', power')

getRH :: (V.Vector Word, V.Vector Word) -> Int -> Int -> Word
getRH (h, power) l r = hr - pr_1 * hl
  where hr = h V.! r
        pr_1 = power V.! (r-l)
        hl = h V.! l

bisectRight :: Ord a => (Int -> a) -> a -> Int -> Int -> Int
bisectRight f x lo hi
  | lo >= hi  = lo
  | x < f mid = bisectRight f x lo mid
  | otherwise = bisectRight f x (mid+1) hi
  where
    mid = lo + (hi - lo) `div` 2

readInt = fst . fromJust . BS.readInt
getInt = readInt <$> BS.getLine

main = do
  n <- getInt
  s <- BS.getLine

  let rh1 = rollingHash s 100000007
      rh2 = rollingHash s 10007
      check k =
        V.or $ V.map (\  i ->
                     let hi1 = getRH rh1 i (i+k)
                         hi2 = getRH rh2 i (i+k)
                         f = (\  j -> (hi1 == getRH rh1 j (j+k) &&
                                       hi2 == getRH rh2 j (j+k)))
                     in
                       V.or $ V.map f (V.generate (n-i-2*k+1) (+(i+k))))
                  (V.generate (n-2*k) id)
      ans = bisectRight (not . check) False 0 (n `div` 2 + 1) - 1

  print ans

Score : 500 points

Problem Statement

Given is a string S of length N.

Find the maximum length of a non-empty string that occurs twice or more in S as contiguous substrings without overlapping.

More formally, find the maximum positive integer len such that there exist integers l_1 and l_2 ( 1 \leq l_1, l_2 \leq N - len + 1 ) that satisfy the following:

l_1 + len \leq l_2

S[l_1+i] = S[l_2+i] (i = 0, 1, ..., len - 1)

If there is no such integer len, print 0.

Constraints

2 \leq N \leq 5 \times 10^3

|S| = N

S consists of lowercase English letters.

Input

Input is given from Standard Input in the following format:

N
S

Output

Print the maximum length of a non-empty string that occurs twice or more in S as contiguous substrings without overlapping. If there is no such non-empty string, print 0 instead.

Sample Input 1

5
ababa

Sample Output 1

2

The strings satisfying the conditions are: a, b, ab, and ba. The maximum length among them is 2, which is the answer.
Note that aba occurs twice in S as contiguous substrings, but there is no pair of integers l_1 and l_2 mentioned in the statement such that l_1 + len \leq l_2.

Sample Input 2

2
xy

Sample Output 2

0

No non-empty string satisfies the conditions.

Sample Input 3

13
strangeorange

Sample Output 3

5


{-# LANGUAGE BangPatterns #-}
import           Control.Monad
import qualified Control.Monad.ST            as ST
import           Data.Array.IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Maybe
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

rollingHash :: BS.ByteString -> Int -> (V.Vector Word, V.Vector Word)
rollingHash s b = ST.runST $ do
  let sz = BS.length s
      b' = fromIntegral b
  h <- VM.new (sz+1)
  VM.write h 0 (0::Word)
  power <- VM.new (sz+1)
  VM.write power 0 (1::Word)
  forM_ [0..(sz-1)] $ \i -> do
    powi <- VM.read power i
    VM.write power (i+1) (powi * b')
    hi <- VM.read h i
    let si = fromIntegral $ ord $ BS.index s i
    VM.write h (i+1) (hi * b' + si)
  h' <- V.freeze h
  power' <- V.freeze power
  return (h', power')

getRH :: (V.Vector Word, V.Vector Word) -> Int -> Int -> Word
getRH (h, power) l r = hr - pr_1 * hl
  where hr = h V.! r
        pr_1 = power V.! (r-l)
        hl = h V.! l

bisectRight :: Ord a => (Int -> a) -> a -> Int -> Int -> Int
bisectRight f x lo hi
  | lo >= hi  = lo
  | x < f mid = bisectRight f x lo mid
  | otherwise = bisectRight f x (mid+1) hi
  where
    mid = lo + (hi - lo) `div` 2

readInt = fst . fromJust . BS.readInt
getInt = readInt <$> BS.getLine

main = do
  n <- getInt
  s <- BS.getLine

  let rh1 = rollingHash s 100000007
      rh2 = rollingHash s 10007
      check k =
        V.or $ V.map (\ !i ->
                     let hi1 = getRH rh1 i (i+k)
                         hi2 = getRH rh2 i (i+k)
                         f = (\ !j -> (hi1 == getRH rh1 j (j+k) &&
                                       hi2 == getRH rh2 j (j+k)))
                     in
                       V.or $ V.map f (V.fromList [(i+k)..(n-k)]))
                  (V.fromList [0..(n-2*k)])
      ans = bisectRight (not . check) False 0 (n `div` 2 + 1) - 1

  print ans


import           Control.Monad
import qualified Control.Monad.ST            as ST
import           Data.Array.IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Maybe
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

rollingHash :: BS.ByteString -> Int -> (V.Vector Word, V.Vector Word)
rollingHash s b = ST.runST $ do
  let sz = BS.length s
      b' = fromIntegral b
  h <- VM.new (sz+1)
  VM.write h 0 (0::Word)
  power <- VM.new (sz+1)
  VM.write power 0 (1::Word)
  forM_ [0..(sz-1)] $ \i -> do
    powi <- VM.read power i
    VM.write power (i+1) (powi * b')
    hi <- VM.read h i
    let si = fromIntegral $ ord $ BS.index s i
    VM.write h (i+1) (hi * b' + si)
  h' <- V.freeze h
  power' <- V.freeze power
  return (h', power')

getRH :: (V.Vector Word, V.Vector Word) -> Int -> Int -> Word
getRH (h, power) l r = hr - pr_1 * hl
  where hr = h V.! r
        pr_1 = power V.! (r-l)
        hl = h V.! l

bisectRight :: Ord a => (Int -> a) -> a -> Int -> Int -> Int
bisectRight f x lo hi
  | lo >= hi  = lo
  | x < f mid = bisectRight f x lo mid
  | otherwise = bisectRight f x (mid+1) hi
  where
    mid = lo + (hi - lo) `div` 2

readInt = fst . fromJust . BS.readInt
getInt = readInt <$> BS.getLine

main = do
  n <- getInt
  s <- BS.getLine

  let rh1 = rollingHash s 100000007
      rh2 = rollingHash s 10007
      check k =
        or $ map (\i ->
                     let hi1 = getRH rh1 i (i+k)
                         hi2 = getRH rh2 i (i+k)
                         f = (\j -> (hi1 == getRH rh1 j (j+k) &&
                                     hi2 == getRH rh2 j (j+k)))
                     in
                       or $ map f [(i+k)..(n-k)])
                  [0..(n-2*k)]
      ans = bisectRight (not . check) False 0 (n `div` 2 + 1) - 1

  print ans


{-# LANGUAGE BangPatterns, MultiWayIf #-}

import Control.Applicative ((<$>))
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  n <- read <$> getLine
  s <- VU.unfoldrN n BS.uncons <$> BS.getLine
  print $ VU.maximum
    $ VU.map (\ !gap -> max gap $ test s $ VU.drop gap s)
    $ VU.tail $ VU.generate n id

test :: VU.Vector Char -> VU.Vector Char -> Int
test v1 v2
 = VU.maximum
   $ VU.scanl' (\ !l !b -> if b then l+1 else 0) (0::Int)
   $ VU.zipWith (==) v1 v2


main=do
 a<-readLn;s<-getLine
 putStrLn(if a>=3200 then s else "red")

Score : 100 points

Problem Statement

You will be given an integer a and a string s consisting of lowercase English letters as input.

Write a program that prints s if a is not less than 3200 and prints red if a is less than 3200.

Constraints

2800 \leq a < 5000

s is a string of length between 1 and 10 (inclusive).

Each character of s is a lowercase English letter.

Input

Input is given from Standard Input in the following format:

a
s

Output

If a is not less than 3200, print s; if a is less than 3200, print red.

Sample Input 1

3200
pink

Sample Output 1

pink

a = 3200 is not less than 3200, so we print s = pink.

Sample Input 2

3199
pink

Sample Output 2

red

a = 3199 is less than 3200, so we print red.

Sample Input 3

4049
red

Sample Output 3

red

a = 4049 is not less than 3200, so we print s = red.


main=do
 a<-readLn
 s<-getLine
 putStrLn$if a<3200 then"red"else s


import Control.Applicative
import Control.Monad

main :: IO ()
main = do
    n <- readLn
    s <- getLine
    putStrLn $ (if n >= 3200 then s else "red")


main = do
    a <- readLn
    sikuramen <- getLine
    putStrLn $ if a>=3200 then sikuramen else "red"


main = do
    a <- getLine
    s <- getLine
    putStrLn $ solve (read a :: Int) s

solve a s | a >= 3200 = s
          | otherwise = "red"


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Control.Monad.State.Strict
import Data.Char
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = runStateT $
    (,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = runStateT $
    (,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt4 :: Parser (Int, Int, Int, Int)
parseInt4 = runStateT $
    (,,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)

main = do
  !n <- readLn :: IO Int
  !a <- U.unfoldrN n parseInt <$> C.getContents :: IO (U.Vector Int)
  let !ans = recip $ U.foldr (\x ttl -> ttl + recip (fromIntegral x)) 0.0 a :: Double
  print ans


main = do
  a <- readLn
  s <- getLine
  let f = if a >= 3200 then s else "red"
  print $ f


main:: IO ()
main = do
    a <- readLn
    s <- getLine
    putStrLn $ if a >= 3200 then s else "red"


main = do
  a <- readLn
  s <- getLine
  if a < 3200
    then putStrLn "red"
    else putStrLn s


main :: IO ()
main = do
  a <- readLn :: IO Int
  s <- getLine
  putStrLn $ if a >= 3200 then s else "red"


import Data.Bits
import Data.List
import Control.Monad
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as VM
import Control.Monad.ST
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Lazy.Char8 as B
--import Debug.Trace

main :: IO ()
main = do
  n <- readLn :: IO Int
  s <- getLine
  putStrLn $ if n >= 3200 then s else "red"


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	a <- readInt
	s <- getLine
	putStrLn $ which s "red" $ 3200 <= a


main :: IO ()
main = do
    a <- readLn :: IO Int
    s <- getLine :: IO String
    putStrLn $ if a >= 3200 then s else "red"


import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List
import Data.Array
import Control.Monad

main = do
  li <- BS.getLine
  let [n,q] = unfoldr (BS.readInt . BS.dropWhile isSpace) li
  abs <- forM [2..n] get2
  pxs <- forM [1..q] get2
  let ans = compute n q abs pxs
  putStrLn $ unwords $ map show ans

get2 _ = do
  li <- BS.getLine
  let [a,b] = unfoldr (BS.readInt . BS.dropWhile isSpace) li
  return (a,b)

compute :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [Int]
compute n _ abs pxs = ans
  where
    xa = accumArray (+) 0 (1,n) pxs
    ta = accumArray (flip (:)) [] (1,n) [ p | (a,b) <- abs, p <- [(a,b),(b,a)] ]
    ans = elems $ array (1,n) $ dfs 0 0 1
    dfs p v cur = (cur, v1) : concatMap (dfs cur v1) (delete p $ ta ! cur)
      where
        v1 = v + xa ! cur

Score : 400 points

Problem Statement

Given is a rooted tree with N vertices numbered 1 to N.
The root is Vertex 1, and the i-th edge (1 \leq i \leq N - 1) connects Vertex a_i and b_i.

Each of the vertices has a counter installed. Initially, the counters on all the vertices have the value 0.

Now, the following Q operations will be performed:

Operation j (1 \leq j \leq Q): Increment by x_j the counter on every vertex contained in the subtree rooted at Vertex p_j.

Find the value of the counter on each vertex after all operations.

Constraints

2 \leq N \leq 2 \times 10^5

1 \leq Q \leq 2 \times 10^5

1 \leq a_i < b_i \leq N

1 \leq p_j \leq N

1 \leq x_j \leq 10^4

The given graph is a tree.

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N Q
a_1 b_1
:
a_{N-1} b_{N-1}
p_1 x_1
:
p_Q x_Q

Output

Print the values of the counters on Vertex 1, 2, \ldots, N after all operations, in this order, with spaces in between.

Sample Input 1

4 3
1 2
2 3
2 4
2 10
1 100
3 1

Sample Output 1

100 110 111 110

The tree in this input is as follows:

Each operation changes the values of the counters on the vertices as follows:

Operation 1: Increment by 10 the counter on every vertex contained in the subtree rooted at Vertex 2, that is, Vertex 2, 3, 4. The values of the counters on Vertex 1, 2, 3, 4 are now 0, 10, 10, 10, respectively.

Operation 2: Increment by 100 the counter on every vertex contained in the subtree rooted at Vertex 1, that is, Vertex 1, 2, 3, 4. The values of the counters on Vertex 1, 2, 3, 4 are now 100, 110, 110, 110, respectively.

Operation 3: Increment by 1 the counter on every vertex contained in the subtree rooted at Vertex 3, that is, Vertex 3. The values of the counters on Vertex 1, 2, 3, 4 are now 100, 110, 111, 110, respectively.

Sample Input 2

6 2
1 2
1 3
2 4
3 6
2 5
1 10
1 10

Sample Output 2

20 20 20 20 20 20


import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List
import Data.Array
import Control.Monad

main = do
  li <- BS.getLine
  let [n,q] = unfoldr (BS.readInt . BS.dropWhile isSpace) li
  abs <- forM [2..n] get2
  pxs <- forM [1..q] get2
  let ans = compute n q abs pxs
  putStrLn $ unwords $ map show ans

get2 _ = do
  li <- BS.getLine
  let [a,b] = unfoldr (BS.readInt . BS.dropWhile isSpace) li
  return (a,b)

compute :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [Int]
compute n _ abs pxs = ans
  where
    xa = accumArray (+) 0 (1,n) pxs
    ta = accumArray (++) [] (1,n) [ p | (a,b) <- abs, p <- [(a,[b]),(b,[a])] ]
    ans = xa ! 1 : (map snd $ sort $ concatMap (dfs 1 (xa!1)) (ta ! 1))
    dfs p v cur = (cur, v1) : concatMap (dfs cur v1) (delete p (ta ! cur))
      where
        v1 = v + xa ! cur


import Control.Monad
import Control.Monad.ST
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as M
import Data.Array.ST
import Data.Array.IArray

mapFromList :: Ord a => [(a,a)] -> M.Map a [a]
mapFromList []           = M.empty
mapFromList ((x1,x2):xs) = M.insertWith (\[a] b -> a:b) x1 [x2]
                         $ M.insertWith (\[a] b -> a:b) x2 [x1]
                         $ mapFromList xs

solve :: Int -> [(Int,Int)] -> [(Int,Int)] -> ST s (STUArray s Int Int)
solve n a p = do
    let m = mapFromList a
        ia = listArray (1,n) $ map (\i ->
            M.findWithDefault [] i m) [1..n] :: Array Int [Int]
    ma <- newArray (1,n) 0
    mapM_ (\(a,b) -> do
        v <- readArray ma a
        writeArray ma a (b + v)) p
    dfs ia ma 1 (-1)
    return ma
  where
    dfs :: Array Int [Int] ->  STUArray s Int Int -> Int -> Int -> ST s ()
    dfs ia ma i p = do
        pv <- readArray ma i
        forM_ (filter (/=p) (ia!i)) (\j -> do
            cv <- readArray ma j
            writeArray ma j (cv + pv)
            dfs ia ma j i)

main :: IO ()
main = do
    let tuple [a,b] = (a,b)
    [n,q] <- map read . words <$> getLine :: IO [Int]
    a <- replicateM (n-1) $ tuple
        . map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
    p <- replicateM q $ tuple
        . map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
    mapM_ print . elems $ runSTUArray $ solve n a p


module Main where

import Data.List
import Control.Monad
import Control.Monad.ST (runST)
import Debug.Trace
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector as V
import Data.Function (fix)

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as = let
    (fo, la) = span f as
    las = case la of
        [] -> []
        xs -> split f $ tail xs
    in
        case fo of
            [] -> las
            xs -> xs : las

solve :: Int -> [(Int, Int)] -> [(Int, Int)] -> [Int]
solve n abList pxList = runST $ do
        graph <- MV.replicate (n + 1) []
        forM_ abList $ \(a, b) -> do
            MV.modify graph (a:) b
            MV.modify graph (b:) a
        points <- MV.replicate (n + 1) 0
        forM_ pxList $ \(p, x) -> MV.modify points (+x) p
        let dfs = fix $ \next point parent -> do
                myPoint <- MV.read points point
                sons <- MV.read graph point
                forM_ sons $ \son ->
                    if son == parent then return ()
                    else do
                        MV.modify points (+myPoint) son
                        next son point
        dfs 1 (negate 1)
        frozenAns <- V.freeze points
        pure . tail $  V.toList frozenAns

main = do
    (n, q) <- readTuple2
    abList <- replicateM (n - 1) readTuple2
    pxList <- replicateM q readTuple2
    putStrLn $ unwords  $ show <$> solve n abList pxList


import Data.Array
import Control.Monad

main = do
  li <- getLine
  let [n,q] = map read $ words li
  bas <- forM [2..n] (\_ -> do
    li <- getLine
    let [a,b] = map read $ words li
    return (b,a)
    )
  pxs <- forM [1..q] (\_ -> do
    li <- getLine
    let [p,x] = map read $ words li
    return (p,x)
    )
  let ans = compute n q bas pxs
  putStrLn $ unwords $ map show ans

compute :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [Int]
compute n q bas pxs = elems sa
  where
    xa = accumArray (+) 0 (1,n) pxs
    parent = array (1,n) bas
    sa = listArray (1,n) ( xa ! 1 : [ xa ! i + sa ! (parent ! i) | i <- [2..n] ])


{-# OPTIONS_GHC -O2 -Wall #-}
module Main where
import qualified Data.Vector.Unboxed.Mutable as MV
import qualified Data.Vector.Unboxed as V
import Control.Monad

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

main = do
  [n, q] <- readL
  edges <- V.replicateM (n-1) $ fmap (\[p, q] -> (p-1, q-1)) readL
  counters <- MV.replicate n 0
  replicateM_ q $ do
    [p, x] <- readL
    MV.modify counters (+x) (p-1)
  V.forM_ edges $ \(p, q) -> do
    v <- MV.read counters p
    MV.modify counters (+v) q
  V.unsafeFreeze counters >>= putStrLn . unwords . map show . V.toList


import qualified Data.Vector.Unboxed as U
import qualified Data.Vector as V
import qualified Data.ByteString.Char8 as C
import qualified Data.Array.IO as A
import Debug.Trace
import Data.List
import Control.Monad
import Data.Ord

import qualified Data.IntMap as M
import qualified Data.Sequence as S

import Data.Foldable

r :: Int -> IO (U.Vector Int)
r n = U.unfoldrN n (C.readInt . C.dropWhile (==' ')) <$> C.getLine

r' :: IO [Int]
r'  =   unfoldr    (C.readInt . C.dropWhile (==' ')) <$> C.getLine

rp :: IO (Int,Int)
rp  = toTup . unfoldr    (C.readInt . C.dropWhile (==' ')) <$> C.getLine

toTup [a,b] = (a,b)

main :: IO ()
main = do
    [n,q] <- r' :: IO [Int]

    ab <- replicateM (n-1) $ do
        [a,b] <- r'
        return (a, S.singleton b)

    let mp = M.fromListWith (S.><) ab :: M.IntMap (S.Seq Int)

    px <- replicateM q rp

    let pMap = M.fromListWith (+) px :: M.IntMap Int

    let slMp = solve 1 0 mp pMap
    putStrLn $ intercalate " " $ map (show . snd) (sortBy (comparing fst) $ toList slMp)

solve :: Int -> Int -> M.IntMap (S.Seq Int) -> M.IntMap Int -> S.Seq (Int,Int)
solve pos vac mp pMap =
    let children = case M.lookup pos mp of
                    Just c -> c
                    Nothing -> S.empty
        curVal = case M.lookup pos pMap of
                    Just v -> v
                    Nothing -> 0
        nVal  = curVal + vac
        nacMp = (pos,nVal)
    in -- traceShow (pos,vac,nVal) $
        nacMp S.<| (do  nPos <- children
                        solve nPos nVal mp pMap)


import qualified Data.Map as M
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector.Unboxed as V
import Data.List

main = do
  [n,q] <- map (fromIntegral.fst.fromJust.BS.readInteger).BS.words<$>BS.getLine
  edges <- replicateM (n-1) $ (\(a:b:_)->(a,b)).map (fromIntegral.fst.fromJust.BS.readInteger).BS.words<$>BS.getLine
  pxs   <- replicateM q $ (\(a:b:_)->(a,b)).map (fromIntegral.fst.fromJust.BS.readInteger).BS.words<$>BS.getLine
  putStr $ unwords $ map show $ solve n q edges pxs

solve :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [Int]
solve n q edges pxs = dfs [(1,0)] M.empty tree where
  tree = foldl (\t (a,b)->M.adjust (b:) a t)
    (M.fromDistinctAscList $ zip [1..n] (repeat [])) edges
  counter = V.fromList $ map (sum.map snd) $ groupBy (\(a,_)(b,_)->a==b) $ sortBy (\(a,_)(b,_)->compare a b) $ zip[1..n](repeat 0)++pxs
  dfs :: [(Int,Int)] -> M.Map Int Int -> M.Map Int [Int] -> [Int]
  dfs [] ans _ = map snd $ M.toAscList ans
  dfs ((v,c):vs) ans tree = dfs
    (zip (tree M.! v) (repeat new) ++ vs)
    (M.insert v new ans)
    (M.delete v tree)
    where new = c + counter V.! (v-1)