{-# LANGUAGE BangPatterns #-}
import Control.Arrow (second)
import Control.Monad
import Control.Monad.Fix
import Data.Foldable (foldl')
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (accursedUnutterablePerformIO)
import Debug.Trace

uread :: VUM.Unbox a => Int -> VUM.IOVector a -> a
uread i v = accursedUnutterablePerformIO $ VUM.unsafeRead v i

uwrite :: VUM.Unbox a => Int -> a -> VUM.IOVector a -> VUM.IOVector a
uwrite i a v = accursedUnutterablePerformIO $ VUM.unsafeWrite v i a >> return v

uswap :: VUM.Unbox a => Int -> Int -> VUM.IOVector a -> VUM.IOVector a
uswap i j v = accursedUnutterablePerformIO $ VUM.unsafeSwap v i j >> return v

ufreeze :: VUM.Unbox a => VUM.IOVector a -> VU.Vector a
ufreeze v = accursedUnutterablePerformIO $ VU.unsafeFreeze v

uthaw :: VUM.Unbox a => VU.Vector a -> VUM.IOVector a
uthaw v = accursedUnutterablePerformIO $ VU.unsafeThaw v

newtype UnionFind = UnionFind (VUM.IOVector Int, VUM.IOVector Int)

new :: Int -> UnionFind
new n = UnionFind
  ( uthaw $! VU.fromList [0 .. n - 1]
  , accursedUnutterablePerformIO $! VUM.replicate n 1
  )

findUF :: UnionFind -> Int -> Int
findUF (UnionFind (elems, _)) k = fix
  ( \f (elems, k, path) -> case uread k elems of
    n | n == k -> foldl' (\acc p -> uwrite p n acc) elems path `seq` n
    n          -> f (elems, n, n : path)
  )
  (elems, k, [k])

sizeUF :: UnionFind -> Int -> Int
sizeUF uf@(UnionFind (_, sizes)) i =
  let j = findUF uf i in j `seq` uread j sizes

unionUF :: UnionFind -> Int -> Int -> UnionFind
unionUF uf@(UnionFind (elem, sizes)) i j =
  let pi = findUF uf i
      pj = findUF uf j
      si = uread pi sizes
      sj = uread pj sizes
  in  if pi == pj
        then uf
        else
          let (t1, t2) = if si < sj then (pi, pj) else (pj, pi)
          in  UnionFind (uwrite t1 t2 elem, uwrite t2 (si + sj) sizes)

solve :: Int -> Int -> VU.Vector (Int, Int) -> VU.Vector Int
solve n m abs =
  undefined $ VU.init $ ufreeze $ (\(_, _, _, acc) -> acc) $ VU.foldr'
    go
    ( new n
    , m - 1
    , nC2
    , uwrite m nC2 $ accursedUnutterablePerformIO $ VUM.unsafeNew (m + 1)
    )
    abs
 where
  go (a, b) (uf, k, prev, acc) =
    let ga  = findUF uf a
        gb  = findUF uf b
        n1  = sizeUF uf a
        n2  = sizeUF uf b
        res = prev - (if ga == gb then 0 else n1 * n2)
    in  (unionUF uf a b, k - 1, res, uwrite k prev acc)

  nC2 = n * (n - 1) `div` 2

main = do
  let readInt = fmap (second B.tail) . B.readInt

  (n, m) <-
    (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldrN 2 readInt <$> B.getLine
  abs <- VU.replicateM
    m
    (   (\vec -> (vec VU.! 0 - 1, vec VU.! 1 - 1))
    .   VU.unfoldrN 2 readInt
    <$> B.getLine
    )

  VU.mapM_ print $ solve n m abs


{-# LANGUAGE BangPatterns #-}
import Data.Int
import Control.Monad
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.ByteString.Char8 as BS

solve :: Int -> Int -> V.Vector (Int,Int) -> V.Vector Int64
solve n m edges = V.create $ do
  -- m 番目の島から順番に島同士が「繋がっていく」と考える

  -- j = assocs ! i : i 番目の島の親が j
  -- assocs <- VM.new n
  -- forM_ [0..n-1] $ \i -> VM.write assocs i i
  assocs <- V.thaw $ V.enumFromN 0 n

  -- numberOfElements ! i : i番目の島と同じ連結成分に属する島の個数
  numberOfElements <- VM.replicate n 1

  rank <- VM.replicate n (0 :: Int)

  let getRoot !i xs = do
        !j <- VM.read assocs i
        if i == j
          then forM_ xs (\l -> VM.write assocs l i) >> return i
          else getRoot j (i:xs)

      -- i 番目の島と j 番目の島を繋いで、新たに繋がった組み合わせの個数を返す
      unify !i !j = do
        !i' <- getRoot i []
        !j' <- getRoot j []
        if i' == j'
          then return 0
          else do
          !ri <- VM.read rank i'
          !rj <- VM.read rank j'
          !k <- case compare ri rj of
                  EQ -> do VM.write rank i' (ri + 1)
                           return i'
                  LT -> return j'
                  GT -> return i'
          VM.write assocs i' k
          VM.write assocs j' k
          !n1 <- VM.read numberOfElements i'
          !n2 <- VM.read numberOfElements j'
          VM.write numberOfElements k (n1 + n2)
          return $! n1 * n2
  result <- VM.new m
  VM.write result (m-1) $ fromIntegral n * (fromIntegral n - 1) `quot` 2
  forM_ [m-1,m-2..1] $ \i -> do
    let (a,b) = edges V.! i
    convenience <- unify a b
    prevInconveniences <- VM.read result i
    VM.write result (i-1) (prevInconveniences - convenience)
  return result

readIntPair :: IO (Int, Int)
readIntPair = do
  [a,b] <- BS.words <$> BS.getLine
  case (BS.readInt a, BS.readInt b) of
    (Just (a', _), Just (b', _)) -> return (a',b')

main = do
  (n,m) <- readIntPair
  -- [n,m] <- map (read . BS.unpack) . BS.words <$> BS.getLine -- 2 <= n <= 10^5, 1 <= m <= 10^5
  edges <- V.replicateM m $ do
    (a,b) <- readIntPair
    -- [a,b] <- map (read . BS.unpack) . BS.words <$> BS.getLine
    return (a-1, b-1)
  -- maxIncovenience < n * (n - 1) / 2 < 10^10 (2^32 < 10^10)
  let result = solve n m edges
  V.forM_ result print

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

Score : 400 points

Problem Statement

There are N islands and M bridges.

The i-th bridge connects the A_i-th and B_i-th islands bidirectionally.

Initially, we can travel between any two islands using some of these bridges.

However, the results of a survey show that these bridges will all collapse because of aging, in the order from the first bridge to the M-th bridge.

Let the inconvenience be the number of pairs of islands (a, b) (a < b) such that we are no longer able to travel between the a-th and b-th islands using some of the bridges remaining.

For each i (1 \leq i \leq M), find the inconvenience just after the i-th bridge collapses.

Constraints

All values in input are integers.

2 \leq N \leq 10^5

1 \leq M \leq 10^5

1 \leq A_i < B_i \leq N

All pairs (A_i, B_i) are distinct.

The inconvenience is initially 0.

Input

Input is given from Standard Input in the following format:

N M
A_1 B_1
A_2 B_2
\vdots
A_M B_M

Output

In the order i = 1, 2, ..., M, print the inconvenience just after the i-th bridge collapses.
Note that the answer may not fit into a 32-bit integer type.

Sample Input 1

4 5
1 2
3 4
1 3
2 3
1 4

Sample Output 1

0
0
4
5
6

For example, when the first to third bridges have collapsed, the inconvenience is 4 since we can no longer travel between the pairs (1, 2), (1, 3), (2, 4) and (3, 4).

Sample Input 2

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

Sample Output 2

8
9
12
14
15

Sample Input 3

2 1
1 2

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.


{-# LANGUAGE BangPatterns #-}
module Main where

import Data.List
import Control.Monad
import Debug.Trace
import Data.Bits
import Data.Array.MArray
import Data.Array.ST
import Control.Monad.ST
import Control.Applicative
import Data.STRef

type UnionFind s = (STArray s Int (Maybe Int), STArray s Int Int)
newUnionFind :: Int -> Int -> ST s (UnionFind s)
newUnionFind start end = liftA2 (,) (newArray (start, end) Nothing) (newArray (start, end) 1)

root :: UnionFind s -> Int -> ST s Int
root (u, t) i = do
    parent <- readArray u i
    parent <- case parent of
        Nothing -> do
            writeArray u i $ Just i
            pure i
        Just p ->
            pure p
    if parent == i then pure parent
    else do
        parent' <- root (u, t) parent
        writeArray u i (Just parent')
        pure parent'

unite :: UnionFind s -> Int -> Int -> ST s ()
unite (u, total) ix iy = do
    rx <- root (u, total) ix
    ry <- root (u, total) iy
    if rx == ry then pure ()
    else do
        sizex <- size (u, total) rx
        sizey <- size (u, total) ry
        writeArray u rx (Just ry)
        writeArray total ry (sizex + sizey)

same :: UnionFind s -> Int -> Int -> ST s Bool
same u x y = liftA2 (==) (root u x) (root u y)

size :: UnionFind s -> Int -> ST s Int
size (u, t) i =   (root (u, t) i) >>= readArray t

solve :: Int -> [Bridge] -> [String]
solve islands bs = runST $ do
    let bs' = reverse $ tail bs
    let initialHuben = islands * (islands -1) `div` 2
    huben <- newSTRef initialHuben
    ans <- newSTRef [show initialHuben]
    u <- newUnionFind 1 islands
    forM_ bs' $ \b -> do
        let (x, y) = b
        isSame <- same u x y
        if isSame then do
            huben' <- readSTRef huben
            ans' <- readSTRef ans
            writeSTRef ans (show huben' : ans')
        else do
            huben' <- readSTRef huben
            sizex <- size u x
            sizey <- size u y
            let newHuben = huben' - sizex * sizey
            writeSTRef huben newHuben
            ans' <- readSTRef ans
            writeSTRef ans (show newHuben : ans')
            unite u x y
    readSTRef ans

type Bridge = (Int, Int)

readBridge :: IO Bridge
readBridge = do
    [s, e] <- fmap read . words <$> getLine
    pure (s, e)

main = do
    [n, m] <- fmap read . words <$> getLine
    bridges <- replicateM m readBridge
    putStrLn $ unlines $ solve n bridges


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

import           Control.Monad       (foldM, replicateM, unless, when)
import           Control.Monad.ST    (ST, runST)
import           Data.Foldable       (for_)
import qualified Data.Vector         as V (enumFromTo, thaw)
import           Data.Vector.Mutable (STVector)
import qualified Data.Vector.Mutable as V (read, write)

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  bridges <- replicateM m $ do
    [a, b] <- map read . words <$> getLine
    pure (a, b)
  for_ (solve n bridges) print

type Island = Int
type Bridge = (Island, Island)
type Inconvenience = Int

solve :: Int -> [Bridge] -> [Inconvenience]
solve n bridges =
  tail $ runST $ do
    uf <- toUnionFind n

    let
      f [] _ = error "first arguement will not be empty"
      f is@(inconvenience : _) (i1, i2) = do
        (s1, contain1) <- find i1 uf
        (s2, contain2) <- find i2 uf
        let bothContained = contain1 == contain2

        unless bothContained $ unite i1 i2 uf

        pure $ (inconvenience - (if bothContained then 0 else s1 * s2)) : is

    foldM f [maxInconvenience] $ reverse bridges
  where
    maxInconvenience :: Inconvenience
    maxInconvenience = n * (n - 1) `div` 2

type Size = Int
type UnionFind s a = STVector s (Size, a)

toUnionFind :: Int -> ST s (UnionFind s Int)
toUnionFind n = V.thaw $ (1,) <$> V.enumFromTo 0 n

find :: Int -> UnionFind s Int -> ST s (Size, Int)
find i uf = do
  (s, i') <- V.read uf i

  if i' == i
    then pure (s, i)
    else do
      (s', i'') <- find i' uf
      V.write uf i' (s', i'') -- path compression
      pure (s', i'')

unite :: Int -> Int -> UnionFind s Int -> ST s ()
unite i1 i2 uf = do
  (s1, representative1) <- find i1 uf
  (s2, representative2) <- find i2 uf

  when (representative1 /= representative2) $ do
    V.write uf representative1 (s1, representative2)
    V.write uf representative2 (s1 + s2, representative2)

{-
-- 素朴なリストでは TLE

type UnionFind a = [[a]]

toUnionFind :: [a] -> UnionFind a
toUnionFind = map pure

find :: Eq a => a -> UnionFind a -> (Size, [a])
find x xss =
  let
    xs = fromJust $ L.find (x `elem`) xss
  in
    (length xs, xs)

union :: Eq a => a -> a -> UnionFind a -> UnionFind a
union x1 x2 xss =
  let
    (contain1, notContain1) = partition (x1 `elem`) xss
    (contain2, notContain2) = partition (x2 `elem`) xss
    containNeither = notContain1 `intersect` notContain2
  in
    (head contain1 ++ head contain2) : containNeither
-}


{-# LANGUAGE TupleSections #-}

import           Control.Monad (replicateM)
import           Data.Foldable (for_)
import           Data.List     (intersect, mapAccumL, partition)
import qualified Data.List     as L (find)
import           Data.Maybe    (fromJust)
import           Data.Vector   (Vector, (!), (//))
import qualified Data.Vector   as V (enumFromTo, generate)

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  bridges <- replicateM m $ do
    [a, b] <- map read . words <$> getLine
    pure (a, b)
  for_ (solve n bridges) print

type Island = Int
type Bridge = (Island, Island)
type Inconvenience = Int

solve :: Int -> [Bridge] -> [Inconvenience]
solve n = reverse . snd . mapAccumL f (maxInconvenience, toUnionFind' n) . reverse
  where
    f ::
      (Inconvenience, UnionFind' Island) ->
      Bridge ->
      ((Inconvenience, UnionFind' Island), Inconvenience)
    f (inconvenience, islandGroups) (i1, i2) =
      let
        (s1, contain1) = find' i1 islandGroups
        (s2, contain2) = find' i2 islandGroups

        bothContained = contain1 == contain2

        inconvenience' =
          inconvenience - (if bothContained then 0 else s1 * s2)
        islandGroups' =
          if bothContained then islandGroups else union' i1 i2 islandGroups
      in
        ((inconvenience', islandGroups'), inconvenience)

    maxInconvenience :: Inconvenience
    maxInconvenience = n * (n - 1) `div` 2

type Size = Int
type UnionFind' a = Vector (Size, a)

toUnionFind' :: Int -> UnionFind' Int
toUnionFind' n = (1,) <$> V.enumFromTo 0 n

find' :: Int -> UnionFind' Int -> (Size, Int)
find' i uf =
  let
    (s, i') = uf ! i
  in
    if i' == i
      then (s, i)
      else find' i' uf

union' :: Int -> Int -> UnionFind' Int -> UnionFind' Int
union' i1 i2 uf =
  let
    (s1, representative1) = find' i1 uf
    (s2, representative2) = find' i2 uf
  in
    if representative1 == representative2
    then uf
    else uf // [(representative1, (s1, representative2)), (representative2, (s1 + s2, representative2))]

-- size :: Int -> UnionFind' Int -> Int

type UnionFind a = [[a]]

toUnionFind :: [a] -> UnionFind a
toUnionFind = map pure

find :: Eq a => a -> UnionFind a -> [a]
find x xss = fromJust $ L.find (x `elem`) xss

union :: Eq a => a -> a -> UnionFind a -> UnionFind a
union x1 x2 xss =
  let
    (contain1, notContain1) = partition (x1 `elem`) xss
    (contain2, notContain2) = partition (x2 `elem`) xss
    containNeither = notContain1 `intersect` notContain2
  in
    (head contain1 ++ head contain2) : containNeither

-- size :: Eq a => a -> [[a]] -> Int
-- size = (length .) . find


{-# OPTIONS_GHC -funbox-strict-fields #-}
module Main where

import Data.Int
import Control.Monad
import Control.Applicative
import Data.Array.IO

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  es <- replicateM m ((\[a, b] -> (a, b)) . map read . words <$> getLine) :: IO [(Int, Int)]
  let len = fromIntegral n :: Int64
  let numOfEdges = len * (len - 1) `div` 2
  uf <- initUf n
  ans <- solve numOfEdges uf 0 [] $ reverse es
  mapM_ print ans

solve :: Int64 -> UnionFind -> Int64 -> [Int64] -> [(Int, Int)] -> IO [Int64]
solve noe uf cnt acc [] = return $ map (noe -) acc
solve noe uf cnt acc ((a, b):edges) = do
  -- update uf
  (uf', isSame) <- sameUf uf a b
  if isSame
  then solve noe uf' cnt (cnt:acc) edges
  else do
    sizeA <- sizeUf uf' a
    sizeB <- sizeUf uf' b
    uf'' <- uniteUf uf' a b
    let cnt' = cnt + fromIntegral (sizeA * sizeB)
    solve noe uf'' cnt' (cnt:acc) edges

-- unionfind

data UnionFind = UnionFind
  { parent :: IOUArray Int Int
  , size :: IOUArray Int Int
  }

initUf :: Int -> IO UnionFind
initUf n = UnionFind
  <$> newListArray (1, n) [1..n]
  <*> newArray (1, n) 1

rootUf :: UnionFind -> Int -> IO (UnionFind, Int)
rootUf uf x = do
  px <- readArray (parent uf) x
  if px == x
  then return (uf, x)
  else do
    (UnionFind parent' size', rx) <- rootUf uf px
    writeArray parent' x rx
    return (UnionFind parent' size', rx)

sameUf :: UnionFind -> Int -> Int -> IO (UnionFind, Bool)
sameUf uf x y = do
  (uf', rx) <- rootUf uf x
  (uf'', ry) <- rootUf uf' y
  return (uf'', rx == ry)

uniteUf :: UnionFind -> Int -> Int -> IO UnionFind
uniteUf uf x y = do
  (uf', x') <- rootUf uf x
  (uf''@(UnionFind parent' size'), y') <- rootUf uf' y
  if x' == y'
  then return uf''
  else do
    sizeX <- readArray size' x'
    sizeY <- readArray size' y'
    if sizeX < sizeY
    then do
      writeArray parent' x' y'
      writeArray size' y' (sizeX + sizeY)
      return $ UnionFind parent' size'
    else do
      writeArray parent' y' x'
      writeArray size' x' (sizeX + sizeY)
      return $ UnionFind parent' size'

sizeUf :: UnionFind -> Int -> IO Int
sizeUf uf x = do
  (UnionFind _ size', x') <- rootUf uf x
  readArray size' x'


main = do
    s <- getLine
    putStrLn $ if isHeisei s then "Heisei" else "TBD"

isHeisei :: String -> Bool
isHeisei s
    | y < 2019 = True
    | y > 2019 = False
    | y == 2019 = case () of
       () | m < 4 -> True
       () | m > 4 -> False
       () | m == 4 -> d <= 30
    where
        y = read $ take 4 s
        m = read $ take 2 $ drop 5 s
        d = read $ drop 8 s

Score : 100 points

Problem Statement

You are given a string S as input. This represents a valid date in the year 2019 in the yyyy/mm/dd format. (For example, April 30, 2019 is represented as 2019/04/30.)

Write a program that prints Heisei if the date represented by S is not later than April 30, 2019, and prints TBD otherwise.

Constraints

S is a string that represents a valid date in the year 2019 in the yyyy/mm/dd format.

Input

Input is given from Standard Input in the following format:

S

Output

Print Heisei if the date represented by S is not later than April 30, 2019, and print TBD otherwise.

Sample Input 1

2019/04/30

Sample Output 1

Heisei

Sample Input 2

2019/11/01

Sample Output 2

TBD


{-# 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
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = getLine >>= putStrLn . which "Heisei" "TBD" . ( <= "2019/04/30" )


import Control.Monad

main = do
    n  <- read <$> getLine
    xu <- forM [1..n] $ \i -> do
        [x, u] <- words <$> getLine
        return (read x, u)
    putStrLn $ show $ solve n xu

solve :: Int -> [(Double, String)] -> Double
solve n xu = sum [if u == "JPY" then x else x * 380000 | (x, u) <- xu]

Score : 200 points

Problem Statement

Takahashi received otoshidama (New Year's money gifts) from N of his relatives.

You are given N values x_1, x_2, ..., x_N and N strings u_1, u_2, ..., u_N as input. Each string u_i is either JPY or BTC, and x_i and u_i represent the content of the otoshidama from the i-th relative.

For example, if x_1 = 10000 and u_1 = JPY, the otoshidama from the first relative is 10000 Japanese yen; if x_2 = 0.10000000 and u_2 = BTC, the otoshidama from the second relative is 0.1 bitcoins.

If we convert the bitcoins into yen at the rate of 380000.0 JPY per 1.0 BTC, how much are the gifts worth in total?

Constraints

2 \leq N \leq 10

u_i = JPY or BTC.

If u_i = JPY, x_i is an integer such that 1 \leq x_i \leq 10^8.

If u_i = BTC, x_i is a decimal with 8 decimal digits, such that 0.00000001 \leq x_i \leq 100.00000000.

Input

Input is given from Standard Input in the following format:

N
x_1 u_1
x_2 u_2
:
x_N u_N

Output

If the gifts are worth Y yen in total, print the value Y (not necessarily an integer).

Output will be judged correct when the absolute or relative error from the judge's output is at most 10^{-5}.

Sample Input 1

2
10000 JPY
0.10000000 BTC

Sample Output 1

48000.0

The otoshidama from the first relative is 10000 yen. The otoshidama from the second relative is 0.1 bitcoins, which is worth 38000.0 yen if converted at the rate of 380000.0 JPY per 1.0 BTC. The sum of these is 48000.0 yen.

Outputs such as 48000 and 48000.1 will also be judged correct.

Sample Input 2

3
100000000 JPY
100.00000000 BTC
0.00000001 BTC

Sample Output 2

138000000.0038

In this case, outputs such as 138001000 and 1.38e8 will also be judged correct.


{-# LANGUAGE BangPatterns #-}

import Data.Array (Array, listArray, accumArray, (!))
import Data.List (sortOn, sortBy)
import Control.Monad (forM_)
import qualified Data.Vector.Unboxed as V

lowerBound x xs = go xs (-1) (V.length xs) where
  go !xs !l !r
    | l==r-1 = r
    | x==(xs V.! m) = m
    | x<=(xs V.! m) = go xs l m
    | otherwise = go xs m r
    where !m = (l+r) `div` 2
{-# INLINE lowerBound #-}

inf = 10^11

a # b = abs (a-b)
{-# INLINE (#) #-}

near q xs
  | q < V.head xs = (-inf, V.head xs)
  | q > V.last xs = (V.last xs, inf)
  | otherwise = (V.unsafeIndex xs (i-1), V.unsafeIndex xs i)
  where i = lowerBound q xs

solv ss ts qs = map calc (V.toList qs) where
  calc q =
    let !(sl, sr) = near q ss
        !(tl, tr) = near q ts
    in minimum [ min (q#sr + sr#tr) (q#tr + tr#sr)
               , min (q#sr + sr#tl) (q#tl + tl#sr)
               , min (q#sl + sl#tr) (q#tr + tr#sl)
               , min (q#sl + sl#tl) (q#tl + tl#sl)
               ]

main = do
  [a,b,q] <- map read . words <$> getLine :: IO [Int]
  ys <- V.fromList . map read . words <$> getContents :: IO (V.Vector Int)
  let ss = V.slice 0 a ys
      ts = V.slice a b ys
      qs = V.slice (a+b) q ys
  putStr . unlines . map show $ solv ss ts qs

Score : 400 points

Problem Statement

Along a road running in an east-west direction, there are A shrines and B temples.
The i-th shrine from the west is located at a distance of s_i meters from the west end of the road, and the i-th temple from the west is located at a distance of t_i meters from the west end of the road.

Answer the following Q queries:

Query i (1 \leq i \leq Q): If we start from a point at a distance of x_i meters from the west end of the road and freely travel along the road, what is the minimum distance that needs to be traveled in order to visit one shrine and one temple? (It is allowed to pass by more shrines and temples than required.)

Constraints

1 \leq A, B \leq 10^5

1 \leq Q \leq 10^5

1 \leq s_1 < s_2 < ... < s_A \leq 10^{10}

1 \leq t_1 < t_2 < ... < t_B \leq 10^{10}

1 \leq x_i \leq 10^{10}

s_1, ..., s_A, t_1, ..., t_B, x_1, ..., x_Q are all different.

All values in input are integers.

Input

Input is given from Standard Input in the following format:

A B Q
s_1
:
s_A
t_1
:
t_B
x_1
:
x_Q

Output

Print Q lines. The i-th line should contain the answer to the i-th query.

Sample Input 1

2 3 4
100
600
400
900
1000
150
2000
899
799

Sample Output 1

350
1400
301
399

There are two shrines and three temples. The shrines are located at distances of 100, 600 meters from the west end of the road, and the temples are located at distances of 400, 900, 1000 meters from the west end of the road.

Query 1: If we start from a point at a distance of 150 meters from the west end of the road, the optimal move is first to walk 50 meters west to visit a shrine, then to walk 300 meters east to visit a temple.

Query 2: If we start from a point at a distance of 2000 meters from the west end of the road, the optimal move is first to walk 1000 meters west to visit a temple, then to walk 400 meters west to visit a shrine. We will pass by another temple on the way, but it is fine.

Query 3: If we start from a point at a distance of 899 meters from the west end of the road, the optimal move is first to walk 1 meter east to visit a temple, then to walk 300 meters west to visit a shrine.

Query 4: If we start from a point at a distance of 799 meters from the west end of the road, the optimal move is first to walk 199 meters west to visit a shrine, then to walk 200 meters west to visit a temple.

Sample Input 2

1 1 3
1
10000000000
2
9999999999
5000000000

Sample Output 2

10000000000
10000000000
14999999998

The road is quite long, and we may need to travel a distance that does not fit into a 32-bit integer.


import Data.Maybe (isJust, fromJust)
import Data.Array

main :: IO ()
main = do
  [a, b, q] <- map read . words <$> getLine
  ss <- sequenceA . replicate a $ read <$> getLine
  ts <- sequenceA . replicate b $ read <$> getLine
  xs <- sequenceA . replicate q $ read <$> getLine
  let
    ss' = listArray (1, a) ss
    ts' = listArray (1, b) ts
    f x = min (g sgl tgl) (g tgl sgl)
      where
        sgl = lg ss'
        tgl = lg ts'
        lg = sequenceA . sequenceA [lookupLT, lookupGT] $ x
        g sgl tgl = minimum . map fromJust . filter isJust . map ((snd . foldl (\(y, d) -> (,) <$> id <*> (d +) . dist y) (x, 0) <$>) . sequenceA) . sequenceA $ [sgl, tgl]
  mapM_ (print . f) xs

dist x y = toInteger . abs $ y - x

lookupLT x ys
  | ys ! l0 >= x
    = Nothing
  | ys ! r0 < x
    = Just $ ys ! r0
  | otherwise
    = lr l0 r0
  where
    (l0, r0) = bounds ys
    lr l r
      | r <= l + 1
        = Just $ ys ! l
      | ys ! m < x
        = lr m r
      | otherwise
        = lr l m
      where
        m = (l + r) `div` 2

lookupGT x ys
  | ys ! r0 <= x
    = Nothing
  | ys ! l0 > x
    = Just $ ys ! l0
  | otherwise
    = lr l0 r0
  where
    (l0, r0) = bounds ys
    lr l r
      | r <= l + 1
        = Just $ ys ! r
      | ys ! m > x
        = lr l m
      | otherwise
        = lr m r
      where
        m = (l + r) `div` 2


main = do
  [a,b] <- map read . words <$> getLine
  print $ if b `mod` a == 0 then a + b else b - a

Score : 100 points

Problem Statement

You are given positive integers A and B.

If A is a divisor of B, print A + B; otherwise, print B - A.

Constraints

All values in input are integers.

1 \leq A \leq B \leq 20

Input

Input is given from Standard Input in the following format:

A B

Output

If A is a divisor of B, print A + B; otherwise, print B - A.

Sample Input 1

4 12

Sample Output 1

16

As 4 is a divisor of 12, 4 + 12 = 16 should be printed.

Sample Input 2

8 20

Sample Output 2

12

Sample Input 3

1 1

Sample Output 3

2

1 is a divisor of 1.


main=do
 [a,b]<-map read.words<$>getLine
 print$if mod b a == 0 then a+b else b-a


import           Control.Monad
import           Data.List

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  as <- replicateM n $ tail . map read . words <$> getLine :: IO [[Int]]
  print
    $ length . filter (== True) . map and . transpose
    $ map (\a -> [x `elem` a | x <- [1 .. m]]) as

Score : 200 points

Problem Statement

Katsusando loves omelette rice.

Besides, he loves crème brûlée, tenderloin steak and so on, and believes that these foods are all loved by everyone.

To prove that hypothesis, he conducted a survey on M kinds of foods and asked N people whether they like these foods or not.

The i-th person answered that he/she only likes the A_{i1}-th, A_{i2}-th, ..., A_{iK_i}-th food.

Find the number of the foods liked by all the N people.

Constraints

All values in input are integers.

1 \leq N, M \leq 30

1 \leq K_i \leq M

1 \leq A_{ij} \leq M

For each i (1 \leq i \leq N), A_{i1}, A_{i2}, ..., A_{iK_i} are distinct.

Constraints

Input is given from Standard Input in the following format:

N M
K_1 A_{11} A_{12} ... A_{1K_1}
K_2 A_{21} A_{22} ... A_{2K_2}
:
K_N A_{N1} A_{N2} ... A_{NK_N}

Output

Print the number of the foods liked by all the N people.

Sample Input 1

3 4
2 1 3
3 1 2 3
2 3 2

Sample Output 1

1

As only the third food is liked by all the three people, 1 should be printed.

Sample Input 2

5 5
4 2 3 4 5
4 1 3 4 5
4 1 2 4 5
4 1 2 3 5
4 1 2 3 4

Sample Output 2

0

Katsusando's hypothesis turned out to be wrong.

Sample Input 3

1 30
3 5 10 30

Sample Output 3

3


module Main where

import qualified Data.List as DL
import qualified Control.Monad as CM

readInt :: String -> Int
readInt = read

solveB :: IO ()
solveB = do
  [n, m] <- fmap read . words <$> getLine
  set <- foldl1 DL.intersect <$> CM.replicateM n (fmap readInt . tail . words <$> getLine)
  print $ length set

main = solveB


import Control.Monad

ret [] l       = foldl (\acc x -> if x == 0 then acc + 1 else acc) 0 l
ret (x : xs) l =
  let
    l' = foldl (\l y -> take (y-1) l ++ [(head $ drop (y - 1) l) - 1] ++ drop y l) l (tail x)
  in
    ret xs l'

main = do
      [n, m] <- (map read . words) <$> getLine
      inputlist <- replicateM n ((map read . words) <$> getLine)
      putStrLn $ show $ ret inputlist $ replicate m n


import Control.Applicative

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

getKA :: Int -> [[Int]] -> IO [[Int]]
getKA 0 out = return out
getKA c out = do
  x <- (: out) <$> tail <$> getArr
  getKA (c-1) x

solve :: Int -> [[Int]] -> [Int] -> [Int]
solve 1 _ out      = out
solve c (x:xs) out = solve (c-1) xs (check x out)
  where
    check :: [Int] -> [Int] -> [Int]
    check a b = filter (/=0) $ map (\x->if elem x a then x else 0) b

main :: IO ()
main = do
  [n,_] <- getArr
  x <- getKA n []
  putStrLn $ show $ length $ solve n (tail x) (head x)


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

main = do
    [n, m] <- fmap read <$> words <$> getLine
    a <- fmap read <$> words <$> getLine
    putStrLn $ solve n m a

solve :: Int -> Int -> [Int] -> String
solve n m a = doit n ""
  where
    doit i s | i >= (ms !! head pr) * 4 = doit (i - (ms !! head pr)) (s ++ show (head pr))
             | otherwise = max (maxnum ++ s) (s ++ maxnum)
      where
        maxnum = show $ head $ filter ok [99999, 99998 .. 1]
        ok num = all (\d -> elem d pr) ds && sum (map (ms !!) ds) == i
          where
            ds = map digitToInt $ show num
    ms = [100, 2, 5, 5, 4, 5, 6, 3, 7, 6]
    pr = filter (\i -> elem i a) [1, 7, 4, 5, 3, 2, 9, 6, 8]

Score : 400 points

Problem Statement

Find the largest integer that can be formed with exactly N matchsticks, under the following conditions:

Every digit in the integer must be one of the digits A_1, A_2, ..., A_M (1 \leq A_i \leq 9).

The number of matchsticks used to form digits 1, 2, 3, 4, 5, 6, 7, 8, 9 should be 2, 5, 5, 4, 5, 6, 3, 7, 6, respectively.

Constraints

All values in input are integers.

2 \leq N \leq 10^4

1 \leq M \leq 9

1 \leq A_i \leq 9

A_i are all different.

There exists an integer that can be formed by exactly N matchsticks under the conditions.

Input

Input is given from Standard Input in the following format:

N M
A_1 A_2 ... A_M

Output

Print the largest integer that can be formed with exactly N matchsticks under the conditions in the problem statement.

Sample Input 1

20 4
3 7 8 4

Sample Output 1

777773

The integer 777773 can be formed with 3 + 3 + 3 + 3 + 3 + 5 = 20 matchsticks, and this is the largest integer that can be formed by 20 matchsticks under the conditions.

Sample Input 2

101 9
9 8 7 6 5 4 3 2 1

Sample Output 2

71111111111111111111111111111111111111111111111111

The output may not fit into a 64-bit integer type.

Sample Input 3

15 3
5 4 6

Sample Output 3

654


import Data.List (sort)
import qualified Data.IntMap as M

main :: IO ()
main = do
  n <- read . head . words <$> getLine
  as <- reverse . sort . map read . words <$> getLine
  let
    maxLength = maximum . (0 :) . (dp M.!)
      where
        dp = M.fromAscList $ map ((,) <$> id <*> f) [0..n]
        f 0 = [0]
        f i = concat . map (map (1 +) . (dp M.!)) . filter (>= 0) . map ((i -) . num) $ as
    l = maxLength n
    dss = sequence . replicate l $ as
    ds = head . filter ((== n) . sum . map num) $ dss
  print $ foldl (\a i -> 10 * a + i) 0 ds

num = (matches M.!)
  where
    matches = M.fromAscList [(1, 2), (2, 5), (3, 5), (4, 4), (5, 5), (6, 6), (7, 3), (8, 7), (9, 6)]


{-# LANGUAGE OverloadedStrings #-}

import           Data.Char
import qualified Data.ByteString.Char8 as B
import qualified Data.Vector.Unboxed   as U
import qualified Data.IntMap           as M

main :: IO ()
main = do
  abs <- U.unfoldrN 6 (B.readInt . B.dropWhile isSpace) <$> B.getContents
  B.putStrLn $ if solve abs then "YES" else "NO"

solve :: U.Vector Int -> Bool
solve = (<= 2) . M.size . M.filter odd  . U.foldr (\k mp -> M.insertWith (+) k 1 mp) M.empty

Score : 200 points

Problem Statement

There are four towns, numbered 1,2,3 and 4.
Also, there are three roads. The i-th road connects different towns a_i and b_i bidirectionally.
No two roads connect the same pair of towns. Other than these roads, there is no way to travel between these towns, but any town can be reached from any other town using these roads.

Determine if we can visit all the towns by traversing each of the roads exactly once.

Constraints

1 \leq a_i,b_i \leq 4(1\leq i\leq 3)

a_i and b_i are different. (1\leq i\leq 3)

No two roads connect the same pair of towns.

Any town can be reached from any other town using the roads.

Input

Input is given from Standard Input in the following format:

a_1 b_1
a_2 b_2
a_3 b_3

Output

If we can visit all the towns by traversing each of the roads exactly once, print YES; otherwise, print NO.

Sample Input 1

4 2
1 3
2 3

Sample Output 1

YES

We can visit all the towns in the order 1,3,2,4.

Sample Input 2

3 2
2 4
1 2

Sample Output 2

NO

Sample Input 3

2 1
3 2
4 3

Sample Output 3

YES


main=do
 [t,x]<-map read.words<$>getLine
 print$t/x

Score : 100 points

Problem Statement

In order to pass the entrance examination tomorrow, Taro has to study for T more hours.

Fortunately, he can leap to World B where time passes X times as fast as it does in our world (World A).

While (X \times t) hours pass in World B, t hours pass in World A.

How many hours will pass in World A while Taro studies for T hours in World B?

Constraints

All values in input are integers.

1 \leq T \leq 100

1 \leq X \leq 100

Input

Input is given from Standard Input in the following format:

T X

Output

Print the number of hours that will pass in World A.

The output will be regarded as correct when its absolute or relative error from the judge's output is at most 10^{-3}.

Sample Input 1

8 3

Sample Output 1

2.6666666667

While Taro studies for eight hours in World B where time passes three times as fast, 2.6666... hours will pass in World A.

Note that an absolute or relative error of at most 10^{-3} is allowed.

Sample Input 2

99 1

Sample Output 2

99.0000000000

Sample Input 3

1 100

Sample Output 3

0.0100000000


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

main = do
  [t, x] <- map (read::String -> Float) . words <$> getLine
  print $ t / x


module Main where
import qualified Control.Monad as C
import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Array as A

int = read :: String -> Int
getWord :: IO String
getWord = do
  c <- getChar
  if C.isSpace c
  then
    return []
  else do
    ws <- getWord
    return (c:ws)
getInt = fmap int getWord
replace pred a = map (\x -> if pred x then a else x)

main = interact $ printer . solver . parser
parser :: String -> [Int]
parser = map int . words
printer :: [Int] -> String
printer = (++"\n") . unwords . map show

solver [n,x,y] = [min x y, max 0 (x+y-n)]

Score : 100 points

Problem Statement

We conducted a survey on newspaper subscriptions.
More specifically, we asked each of the N respondents the following two questions:

Question 1: Are you subscribing to Newspaper X?

Question 2: Are you subscribing to Newspaper Y?

As the result, A respondents answered "yes" to Question 1, and B respondents answered "yes" to Question 2.

What are the maximum possible number and the minimum possible number of respondents subscribing to both newspapers X and Y?

Write a program to answer this question.

Constraints

1 \leq N \leq 100

0 \leq A \leq N

0 \leq B \leq N

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N A B

Output

Print the maximum possible number and the minimum possible number of respondents subscribing to both newspapers, in this order, with a space in between.

Sample Input 1

10 3 5

Sample Output 1

3 0

In this sample, out of the 10 respondents, 3 answered they are subscribing to Newspaper X, and 5 answered they are subscribing to Newspaper Y.

Here, the number of respondents subscribing to both newspapers is at most 3 and at least 0.

Sample Input 2

10 7 5

Sample Output 2

5 2

In this sample, out of the 10 respondents, 7 answered they are subscribing to Newspaper X, and 5 answered they are subscribing to Newspaper Y.

Here, the number of respondents subscribing to both newspapers is at most 5 and at least 2.

Sample Input 3

100 100 100

Sample Output 3

100 100


import Control.Arrow
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet as S
import Data.Ord

main :: IO ()
main = readLn >>= readContents >>= print . solve

solve :: [[Int]] -> Int
solve = count . edit
    where
        count xs = countA S.empty (sortBy cmpA xs) $ sortBy cmpB xs

        edit = zipWith (\n [a, b] -> (n, (a, b))) [0..]

        cmpA lhs rhs = comparing (fst . snd) rhs lhs `mappend` comparing (snd . snd) rhs lhs
        cmpB lhs rhs = comparing (snd . snd) rhs lhs `mappend` comparing (fst . snd) rhs lhs

countA :: S.IntSet -> [(Int, (Int, Int))] -> [(Int, (Int, Int))] -> Int
countA s ((n, (a, b)) : xs) ys
    | S.member n s = countA s xs ys
    | otherwise = a + countB (S.insert n s) xs ys
countA _ _ _ = 0

countB :: S.IntSet -> [(Int, (Int, Int))] -> [(Int, (Int, Int))] -> Int
countB s xs ((n, (a, b)) : ys)
    | S.member n s = countB s xs ys
    | otherwise = countA (S.insert n s) xs ys - b
countB _ _ _ = 0

readLine :: IO [Int]
readLine = unfoldr (fmap (second (maybe B.empty snd . B.uncons)) . B.readInt) <$> B.getLine

readContents :: Int -> IO [[Int]]
readContents = flip replicateM readLine

Score : 400 points

Problem Statement

There are N dishes of cuisine placed in front of Takahashi and Aoki.
For convenience, we call these dishes Dish 1, Dish 2, ..., Dish N.

When Takahashi eats Dish i, he earns A_i points of happiness; when Aoki eats Dish i, she earns B_i points of happiness.

Starting from Takahashi, they alternately choose one dish and eat it, until there is no more dish to eat.
Here, both of them choose dishes so that the following value is maximized: "the sum of the happiness he/she will earn in the end" minus "the sum of the happiness the other person will earn in the end".

Find the value: "the sum of the happiness Takahashi earns in the end" minus "the sum of the happiness Aoki earns in the end".

Constraints

1 \leq N \leq 10^5

1 \leq A_i \leq 10^9

1 \leq B_i \leq 10^9

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N
A_1 B_1
:
A_N B_N

Output

Print the value: "the sum of the happiness Takahashi earns in the end" minus "the sum of the happiness Aoki earns in the end".

Sample Input 1

3
10 10
20 20
30 30

Sample Output 1

20

In this sample, both of them earns 10 points of happiness by eating Dish 1, 20 points by eating Dish 2, and 30 points by eating Dish 3.

In this case, since Takahashi and Aoki have the same "taste", each time they will choose the dish with which they can earn the greatest happiness. Thus, first Takahashi will choose Dish 3, then Aoki will choose Dish 2, and finally Takahashi will choose Dish 1, so the answer is (30 + 10) - 20 = 20.

Sample Input 2

3
20 10
20 20
20 30

Sample Output 2

20

In this sample, Takahashi earns 20 points of happiness by eating any one of the dishes 1, 2 and 3, but Aoki earns 10 points of happiness by eating Dish 1, 20 points by eating Dish 2, and 30 points by eating Dish 3.

In this case, since only Aoki has likes and dislikes, each time they will choose the dish with which Aoki can earn the greatest happiness. Thus, first Takahashi will choose Dish 3, then Aoki will choose Dish 2, and finally Takahashi will choose Dish 1, so the answer is (20 + 20) - 20 = 20.

Sample Input 3

6
1 1000000000
1 1000000000
1 1000000000
1 1000000000
1 1000000000
1 1000000000

Sample Output 3

-2999999997

Note that the answer may not fit into a 32-bit integer.


import Data.List
main = do
       e<-getLine
       let (x:y:_)=sort $ map read (words e)::[Int]
       putStrLn $ show $ (x * y) `div` 2

Score : 100 points

Problem Statement

There is a right triangle ABC with ∠ABC=90°.

Given the lengths of the three sides, |AB|,|BC| and |CA|, find the area of the right triangle ABC.

It is guaranteed that the area of the triangle ABC is an integer.

Constraints

1 \leq |AB|,|BC|,|CA| \leq 100

All values in input are integers.

The area of the triangle ABC is an integer.

Input

Input is given from Standard Input in the following format:

|AB| |BC| |CA|

Output

Print the area of the triangle ABC.

Sample Input 1

3 4 5

Sample Output 1

6

This triangle has an area of 6.

Sample Input 2

5 12 13

Sample Output 2

30

This triangle has an area of 30.

Sample Input 3

45 28 53

Sample Output 3

630

This triangle has an area of 630.


main = do
  [s] <- map read . words <$> getLine
  let xs = func s
  print $ length xs + 4

func :: Int -> [Int]
func 4 = []
func x
  | even x = (x `div` 2) : func (x `div` 2)
  | otherwise = (x * 3 + 1) : func (x * 3 + 1)

Score : 200 points

Problem Statement

A sequence a=\{a_1,a_2,a_3,......\} is determined as follows:

The first term s is given as input.

Let f(n) be the following function: f(n) = n/2 if n is even, and f(n) = 3n+1 if n is odd.

a_i = s when i = 1, and a_i = f(a_{i-1}) when i > 1.

Find the minimum integer m that satisfies the following condition:

There exists an integer n such that a_m = a_n (m > n).

Constraints

1 \leq s \leq 100

All values in input are integers.

It is guaranteed that all elements in a and the minimum m that satisfies the condition are at most 1000000.

Input

Input is given from Standard Input in the following format:

s

Output

Print the minimum integer m that satisfies the condition.

Sample Input 1

8

Sample Output 1

5

a=\{8,4,2,1,4,2,1,4,2,1,......\}. As a_5=a_2, the answer is 5.

Sample Input 2

7

Sample Output 2

18

a=\{7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,......\}.

Sample Input 3

54

Sample Output 3

114


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

getInts :: IO [Int]
getInts = fmap (map (fst . fromJust . C8.readInt) . C8.words) C8.getLine

main :: IO ()
main = do
    _  <- getLine
    hs <- getInts
    print $ solve hs - 1

solve :: [Int] -> Int
solve [] = 0
solve hs = (1 +) . sum . map (solve . map (subtract 1)) . splitOn 0 $ hs

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn _ [] = [[]]
splitOn a (x : xs) | x == a    = [] : res
                   | otherwise = (x : h) : hs
    where res@(h : hs) = splitOn a xs

Score : 300 points

Problem Statement

In a flower bed, there are N flowers, numbered 1,2,......,N. Initially, the heights of all flowers are 0.
You are given a sequence h=\{h_1,h_2,h_3,......\} as input. You would like to change the height of Flower k to h_k for all k (1 \leq k \leq N), by repeating the following "watering" operation:

Specify integers l and r. Increase the height of Flower x by 1 for all x such that l \leq x \leq r.

Find the minimum number of watering operations required to satisfy the condition.

Constraints

1 \leq N \leq 100

0 \leq h_i \leq 100

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N
h_1 h_2 h_3 ...... h_N

Output

Print the minimum number of watering operations required to satisfy the condition.

Sample Input 1

4
1 2 2 1

Sample Output 1

2

The minimum number of watering operations required is 2.
One way to achieve it is:

Perform the operation with (l,r)=(1,3).

Perform the operation with (l,r)=(2,4).

Sample Input 2

5
3 1 2 3 1

Sample Output 2

5

Sample Input 3

8
4 23 75 0 23 96 50 100

Sample Output 3

221


import Control.Monad
import Data.List
import Data.Map (Map,(!))
import qualified Data.Map as M

type Sushi = (Int,Integer)
type EatMap = Map Int [Integer]

main = do
  [n,k] <- map read.words <$> getLine :: IO [Int]
  sushi <- replicateM n $ (\[a,b]->(a,fromIntegral b)).(map read.words) <$> getLine :: IO [Sushi]
  print $ solve n k $ sortBy (\(_,a) (_,b) -> compare b a) sushi

--solve :: Int -> Int -> [Sushi] -> Integer
solve n k sushi = maximum $ go change eatMap howTake x ds
  where
  (eat,remain) = splitAt k sushi
  change = filter (\(t,_) -> M.notMember t eatMap') remain
  eatMap = M.filter (not.null.tail) eatMap'
  eatMap' = M.filter (not.null) eatMap''
  ds = sum $ map snd eat
  (eatMap'',howTake,x) = foldl f (zeroMap,[],0) eat
  zeroMap = M.fromDistinctAscList $ zip [1..n] $ repeat []
  f :: (EatMap, [Int],Integer) -> Sushi -> (EatMap, [Int],Integer)
  f (map,hows,x) (t,d)
    | null (map!t) = (M.adjust (d:) t map, hows, x+1)
    | otherwise  = (M.adjust (d:) t map, t:hows, x)
  go :: [Sushi] -> EatMap -> [Int] -> Integer -> Integer -> [Integer]
  go [] _ _ x ds = [score ds x]
  go _ _ [] x ds = [score ds x]
  go ((t,d):rs) eatMap (h:hs) x ds = score ds x:go rs (M.adjust (d:) t $ M.adjust tail h eatMap) hs (x+1) (ds-head(eatMap!h)+d)
  score :: Integer -> Integer -> Integer
  score ds x = ds + x*x

Score : 400 points

Problem Statement

There are N pieces of sushi. Each piece has two parameters: "kind of topping" t_i and "deliciousness" d_i.
You are choosing K among these N pieces to eat.
Your "satisfaction" here will be calculated as follows:

The satisfaction is the sum of the "base total deliciousness" and the "variety bonus".

The base total deliciousness is the sum of the deliciousness of the pieces you eat.

The variety bonus is x*x, where x is the number of different kinds of toppings of the pieces you eat.

You want to have as much satisfaction as possible.
Find this maximum satisfaction.

Constraints

1 \leq K \leq N \leq 10^5

1 \leq t_i \leq N

1 \leq d_i \leq 10^9

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N K
t_1 d_1
t_2 d_2
.
.
.
t_N d_N

Output

Print the maximum satisfaction that you can obtain.

Sample Input 1

5 3
1 9
1 7
2 6
2 5
3 1

Sample Output 1

26

If you eat Sushi 1,2 and 3:

The base total deliciousness is 9+7+6=22.

The variety bonus is 2*2=4.

Thus, your satisfaction will be 26, which is optimal.

Sample Input 2

7 4
1 1
2 1
3 1
4 6
4 5
4 5
4 5

Sample Output 2

25

It is optimal to eat Sushi 1,2,3 and 4.

Sample Input 3

6 5
5 1000000000
2 990000000
3 980000000
6 970000000
6 960000000
4 950000000

Sample Output 3

4900000016

Note that the output may not fit into a 32-bit integer type.


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import qualified Data.ByteString.Unsafe      as B
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict          as IM
import qualified Data.IntSet                 as IS
import           Data.List
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           Unsafe.Coerce
import           GHC.Exts

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getLine
    ys <- U.unfoldrN m (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n m xs ys

solve :: Int -> Int -> U.Vector Int -> U.Vector Int -> IntMod
solve n m rows cols
    | member (n * m) rowMap, member (n * m) colMap = go 1 (n * m - 1) 1 1
    | otherwise = 0
  where
    !rowMap = revMap (n * m + 1) rows
    !colMap = revMap (n * m + 1) cols

    member :: Int -> U.Vector Int -> Bool
    member x v = not . isNothing $ v U.! x

    go res 0 _  _ = res
    go res x !numR !numC
        | member x rowMap, member x colMap = go res (x - 1) (numR + 1) (numC + 1)
        | member x rowMap = go (res *% numC) (x - 1) (numR + 1) numC
        | member x colMap = go (res *% numR) (x - 1) numR (numC + 1)
        | used < numR * numC = go (res *% (numR *% numC -% used)) (x - 1) numR numC
        | otherwise = 0
      where
        !used = n * m - x

nothing :: Int
nothing = -1

isNothing :: Int -> Bool
isNothing = (== nothing)

revMap :: Int -> U.Vector Int -> U.Vector Int
revMap size v = U.accumulate (flip const) (U.replicate size nothing)
    $ U.imap (flip (,)) v

#define MOD 1000000007

modulus :: Int
modulus = MOD

infixr 8 ^%
infixl 7 *%, /%
infixl 6 +%, -%

type IntMod = Int

intMod :: Int -> IntMod
intMod x = mod x MOD

intModValidate :: Int -> Bool
intModValidate x = 0 <= x && x < MOD

(+%) :: IntMod -> IntMod -> IntMod
(I# x#) +% (I# y#) = I# ((x# +# y#) `remInt#` MOD#)
{-# INLINE (+%) #-}

(-%) :: IntMod -> IntMod -> IntMod
(I# x#) -% (I# y#) = I# ((x# -# y# +# MOD#) `remInt#` MOD#)
{-# INLINE (-%) #-}

(*%) :: IntMod -> IntMod -> IntMod
(I# x#) *% (I# y#) = I# ((x# *# y#) `remInt#` MOD#)
{-# INLINE (*%) #-}

(/%) :: IntMod -> IntMod -> IntMod
(I# x#) /% (I# y#) = go# y# MOD# 1# 0#
  where
    go# a# b# u# v#
        | isTrue# (b# ># 0#) = case a# `quotInt#` b# of
            q# -> go# b# (a# -# (q# *# b#)) v# (u# -# (q# *# v#))
        | otherwise = I# ((x# *# (u# +# MOD#)) `remInt#` MOD#)
{-# INLINE (/%) #-}

(^%) :: IntMod -> Int -> IntMod
x ^% n
    | n > 0 = go 1 x n
    | n == 0 = 1
    | otherwise = go 1 (1 /% x) (-n)
  where
    go !acc !y !m
        | m .&. 1 == 0 = go acc (y *% y) (unsafeShiftR m 1)
        | m == 1 = acc *% y
        | otherwise = go (acc *% y) (y *% y) (unsafeShiftR (m - 1) 1)

Score : 500 points

Problem Statement

Consider writing each of the integers from 1 to N \times M in a grid with N rows and M columns, without duplicates.
Takahashi thinks it is not fun enough, and he will write the numbers under the following conditions:

The largest among the values in the i-th row (1 \leq i \leq N) is A_i.

The largest among the values in the j-th column (1 \leq j \leq M) is B_j.

For him, find the number of ways to write the numbers under these conditions, modulo 10^9 + 7.

Constraints

1 \leq N \leq 1000

1 \leq M \leq 1000

1 \leq A_i \leq N \times M

1 \leq B_j \leq N \times M

A_i and B_j are integers.

Input

Input is given from Standard Input in the following format:

N M
A_1 A_2 ... A_{N}
B_1 B_2 ... B_{M}

Output

Print the number of ways to write the numbers under the conditions, modulo 10^9 + 7.

Sample Input 1

2 2
4 3
3 4

Sample Output 1

2

(A_1, A_2) = (4, 3) and (B_1, B_2) = (3, 4). In this case, there are two ways to write the numbers, as follows:

1 in (1, 1), 4 in (1, 2), 3 in (2, 1) and 2 in (2, 2).

2 in (1, 1), 4 in (1, 2), 3 in (2, 1) and 1 in (2, 2).

Here, (i, j) denotes the square at the i-th row and the j-th column.

Sample Input 2

3 3
5 9 7
3 6 9

Sample Output 2

0

Since there is no way to write the numbers under the condition, 0 should be printed.

Sample Input 3

2 2
4 4
4 4

Sample Output 3

0

Sample Input 4

14 13
158 167 181 147 178 151 179 182 176 169 180 129 175 168
181 150 178 179 167 180 176 169 182 177 175 159 173

Sample Output 4

343772227


{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Foldable
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.ByteString.Char8 as B
import System.IO.Unsafe
import Data.Graph
import Debug.Trace

solve :: Int -> Int -> V.Vector B.ByteString -> Int
solve h w ss = dfs
  where
    dfs :: Int
    dfs = snd $ (\f -> foldl' f (unsafePerformIO (VM.replicate (w*h) False), 0) [0..w*h-1]) $ \(!check,!acc) i ->
      if unsafePerformIO (VM.read check i)
        then (check,acc)
        else let acc' = ((\(x,y) -> x*y + acc) $ search check (toIndex i)) in (check,acc')

    search :: VM.IOVector Bool -> (Int,Int) -> (Int,Int)
    search check = fix (\f (!check,!bw,!i) ->
      if unsafePerformIO (VM.read check (fromIndex i))
        then bw
        else
          let bw' = (if ss !+ i == '#' then first (+1) else second (+1)) bw in
          let ns = VU.fromList $ neighbors check i in
            ns `seq` unsafePerformIO (VM.write check (fromIndex i) True) `seq`
            VU.foldl' (\bw'' i' -> f (check,bw'',i')) bw' ns
      ) . (,,) check (0,0)

    toIndex :: Int -> (Int,Int)
    toIndex n = (n `mod` w, n `div` w)

    fromIndex :: (Int,Int) -> Int
    fromIndex (x,y) = y * w + x

    (!+) :: V.Vector B.ByteString -> (Int,Int) -> Char
    vec !+ (x,y) = (vec V.! y) `B.index` x

    neighbors check (x,y) =
      [(x',y') |
        (ix,iy) <- [(0,1),(0,-1),(1,0),(-1,0)],
        let x' = x + ix, let y' = y + iy,
        0 <= x' && x' < w, 0 <= y' && y' < h,
        ss !+ (x',y') /= ss !+ (x,y),
        not (unsafePerformIO (VM.read check (fromIndex (x,y))))
      ]

main = do
  let readInt = fmap (second B.tail) . B.readInt

  hw <- V.unfoldrN 2 readInt <$> B.getLine
  ss <- V.replicateM (hw V.! 0) B.getLine
  print $ solve (hw V.! 0) (hw V.! 1) ss

Score : 300 points

Problem Statement

There is a grid with H rows and W columns, where each square is painted black or white.

You are given H strings S_1, S_2, ..., S_H, each of length W.
If the square at the i-th row from the top and the j-th column from the left is painted black, the j-th character in the string S_i is #; if that square is painted white, the j-th character in the string S_i is ..

Find the number of pairs of a black square c_1 and a white square c_2 that satisfy the following condition:

There is a path from the square c_1 to the square c_2 where we repeatedly move to a vertically or horizontally adjacent square through an alternating sequence of black and white squares: black, white, black, white...

Constraints

1 \leq H, W \leq 400

|S_i| = W (1 \leq i \leq H)

For each i (1 \leq i \leq H), the string S_i consists of characters # and ..

Input

Input is given from Standard Input in the following format:

H W
S_1
S_2
:
S_H

Output

Print the answer.

Sample Input 1

3 3
.#.
..#
#..

Sample Output 1

10

Some of the pairs satisfying the condition are ((1, 2), (3, 3)) and ((3, 1), (3, 2)), where (i, j) denotes the square at the i-th row from the top and the j-th column from the left.

Sample Input 2

2 4
....
....

Sample Output 2

0

Sample Input 3

4 3
###
###
...
###

Sample Output 3

6


import Control.Monad
import Control.Monad.ST
import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Array.ST

import Control.Monad.Trans.State.Strict
import Data.Char (isSpace)
import Data.Maybe (fromJust)

type Parser a = StateT B.ByteString Maybe a

parseInt :: Parser Int
parseInt = StateT (B.readInt . B.dropWhile isSpace)

parseInt2 :: Parser (Int,Int)
parseInt2 = liftM2 (,) parseInt parseInt

parse :: Parser (Int, Int, [(Int,Int)])
parse = do
    n <- parseInt
    w <- parseInt
    fmap ((,,) n w) (replicateM n parseInt2)

main = do
    (n,w,wvs) <- fromJust.evalStateT parse <$> B.getContents
    print $ f n w wvs

f n w wvs = runST $ do
    dp <- newArray ((0,0),(n,100000)) maxBound :: ST s (STUArray s (Int,Int) Int)
    writeArray dp (0,0) 0
    forM_ [(i,wi,vi,j)|(i,(wi,vi))<-zip [1..] wvs,j<-[0..100000]] $ \(i,wi,vi,j) ->
        writeArray dp (i,j) =<< if j-vi < 0 then readArray dp (i-1,j)
        else min.(+wi).min (maxBound-wi)<$>readArray dp (i-1,j-vi)<*>readArray dp (i-1,j)
    maximum.map fst.filter((<=w).snd)<$>mapM(fmap<$>(,)<*>readArray dp.(,) n)[0..100000]

Score : 100 points

Problem Statement

There are N items, numbered 1, 2, \ldots, N.
For each i (1 \leq i \leq N), Item i has a weight of w_i and a value of v_i.

Taro has decided to choose some of the N items and carry them home in a knapsack.
The capacity of the knapsack is W, which means that the sum of the weights of items taken must be at most W.

Find the maximum possible sum of the values of items that Taro takes home.

Constraints

All values in input are integers.

1 \leq N \leq 100

1 \leq W \leq 10^9

1 \leq w_i \leq W

1 \leq v_i \leq 10^3

Input

Input is given from Standard Input in the following format:

N W
w_1 v_1
w_2 v_2
:
w_N v_N

Output

Print the maximum possible sum of the values of items that Taro takes home.

Sample Input 1

3 8
3 30
4 50
5 60

Sample Output 1

90

Items 1 and 3 should be taken.
Then, the sum of the weights is 3 + 5 = 8, and the sum of the values is 30 + 60 = 90.

Sample Input 2

1 1000000000
1000000000 10

Sample Output 2

10

Sample Input 3

6 15
6 5
5 6
6 4
6 6
3 5
7 2

Sample Output 3

17

Items 2, 4 and 5 should be taken.
Then, the sum of the weights is 5 + 6 + 3 = 14, and the sum of the values is 6 + 6 + 5 = 17.


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Graph (Vertex, Edge, buildG, topSort)
import Data.List (unfoldr, foldl', sort, (\\), delete)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

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

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

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

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
{-# INLINE swap #-}
swap (x, y) = (y, x)
{-# INLINE pair #-}
pair (f, g) x = (f x, g x)
{-# INLINE cross #-}
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

newtype Cofree f a = Cf { unCf :: (a, f (Cofree f a)) }
extract :: Cofree f t -> t
extract = fst . unCf
sub :: Functor f => Cofree f a -> f (Cofree f a)
sub = snd . unCf

newtype Free f a = Fr { unFr :: Either a (f (Free f a)) }
inject :: a -> Free f a
inject = Fr . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = cata phi . ana psi -- phi . fmap (hylo phi psi) . psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = ana psi . cata phi -- In . fmap (meta phi psi) . out
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata (Cf . pair (phi, id))
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana (uncurry either (psi, id) . unFr) . inject
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = histo phi . futu psi
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

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

getTuple :: IO Edge
getTuple = do
  (x:y:_) <- getInts
  return (x, y)

getIdxTuple :: IO Edge
getIdxTuple = cross (pred, pred) <$> getTuple

getProblem :: IO (Int, Int, U.Vector Edge)
getProblem = do
  (n, m) <- getTuple
  xys <- U.replicateM m getIdxTuple
  return (n, m, xys)

data NonEmptyListF a = NonEmptyListF (Vertex, [Vertex], [Int]) (Maybe a) deriving (Show, Functor)

targets :: Int -> U.Vector Edge -> V.Vector [Vertex]
targets n es = V.create $ do
  vec <- VM.replicate n []
  U.forM_ es $ \(s, t) -> do
    VM.modify vec (t:) s
  return vec

transposition :: Map.Map Vertex Int -> Vertex -> Vertex -> Int
transposition dict !s !e = (dict Map.! e) - (dict Map.! s)

transpositions :: Map.Map Vertex Int -> Vertex -> [Vertex] -> [Int]
transpositions dict !v !vs = map (transposition dict v) vs

compileWith :: Map.Map Vertex Int -> V.Vector [Vertex] -> U.Vector Vertex -> V.Vector [Int]
compileWith dict ds vs = V.create $ do
  vec <- VM.replicate (U.length vs) []
  U.forM_ vs $ \s -> do
    VM.write vec (dict Map.! s) $! transpositions dict s (ds V.! s)
  return vec

calcStart :: U.Vector (Vertex, Vertex) -> Int -> [Vertex]
calcStart xys n = filter (\k -> Map.notMember k me) [0..n]
  where
    !me = U.foldl' (\me' (_, v) -> bool me' (Map.insert v True me') (Map.notMember v me')) Map.empty xys

main :: IO ()
main = do
  (!n, !m, !xys) <- getProblem
  print $ solve n xys

solve :: Int -> U.Vector Edge -> Int
solve n xys = dyna phi psi n'
  where
    !n' = n-1
    vs :: U.Vector Vertex
    !vs = U.fromList . topSort . buildG (0, n') . U.toList $ xys
    ds :: V.Vector [Vertex]
    ds = targets n xys
    dict :: Map.Map Vertex Int
    !dict = Map.fromList . U.toList . U.map swap . U.indexed $ vs
    ds' :: V.Vector [Int]
    ds' = compileWith dict ds vs
    startlist :: [Int]
    !startlist = sort $ delete 0 $ transpositions dict (vs U.! 0) $! calcStart xys n'

    psi 0 = NonEmptyListF (vs U.! n', sort $ ds' V.! n', []) Nothing
    psi i = NonEmptyListF (vs U.! (n'-i), sort $ ds' V.! (n'-i), bool [] startlist (i == n')) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    phi (NonEmptyListF _ Nothing) = 0
    phi prev@(NonEmptyListF (_, bps, ss) (Just t))
      | null bps = back 0 1 ss prev
      | otherwise = max (back 0 1 bps prev + 1) (back 0 1 ss prev)

    back :: Int -> Int -> [Int] -> NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    back !ret !i [] _ = ret
    back ret i bps@(j:js) !nel@(NonEmptyListF _ mv)
      | i == j = let  p t = let !et = extract t
                                !st = sub t
                            in back (max ret et) (i+1) js st
                 in maybe ret p mv
      | otherwise = let Just t = mv in back ret (i+1) bps (sub t)

gensample = withFile "DP/lp-sample.txt" WriteMode $ \h -> do
  let xs = [(i,i+j) | i <- [1..1000], j <- [1..1000]]
  let (x, y) = (max 10000 (max (maximum (map fst xs)) (maximum (map snd xs))), length xs)
  hPutStr h (show x)
  hPutStr h " "
  hPutStrLn h (show y)
  forM_ xs $ \(x, y) -> do
    hPutStr h (show x)
    hPutStr h " "
    hPutStrLn h (show y)

Score : 100 points

Problem Statement

There is a directed graph G with N vertices and M edges.
The vertices are numbered 1, 2, \ldots, N, and for each i (1 \leq i \leq M), the i-th directed edge goes from Vertex x_i to y_i.
G does not contain directed cycles.

Find the length of the longest directed path in G.
Here, the length of a directed path is the number of edges in it.

Constraints

All values in input are integers.

2 \leq N \leq 10^5

1 \leq M \leq 10^5

1 \leq x_i, y_i \leq N

All pairs (x_i, y_i) are distinct.

G does not contain directed cycles.

Input

Input is given from Standard Input in the following format:

N M
x_1 y_1
x_2 y_2
:
x_M y_M

Output

Print the length of the longest directed path in G.

Sample Input 1

4 5
1 2
1 3
3 2
2 4
3 4

Sample Output 1

3

The red directed path in the following figure is the longest:

Sample Input 2

6 3
2 3
4 5
5 6

Sample Output 2

2

The red directed path in the following figure is the longest:

Sample Input 3

5 8
5 3
2 3
2 4
5 2
5 1
1 4
4 3
1 3

Sample Output 3

3

The red directed path in the following figure is one of the longest:


import qualified Data.ByteString.Char8 as B
import qualified Data.Vector.Unboxed as U
import Control.Monad
import Data.List

readIntPair :: B.ByteString -> (Int,Int)
readIntPair s = p
    where
    Just p = do
        (n1, s') <- B.readInt s
        (n2, _ ) <- B.readInt (B.tail s')
        return (n1,n2)

main :: IO ()
main = do
    (h, w) <- fmap readIntPair B.getLine
    as <- replicateM h B.getLine
    let modulo = 1000000007 :: Int
    let v0 = U.generate w (\i -> if i == 0 then 1 else 0) :: U.Vector Int
    let vn = foldl' step v0 as
        step tbl line = U.constructN w gen
            where
            gen v | B.index line i == '#' = 0
                  | i == 0 = tbl U.! i
                  | otherwise = (tbl U.! i + v U.! (i - 1)) `mod` modulo
                  where i = U.length v
    print (U.last vn)

Score : 100 points

Problem Statement

There is a grid with H horizontal rows and W vertical columns.
Let (i, j) denote the square at the i-th row from the top and the j-th column from the left.

For each i and j (1 \leq i \leq H, 1 \leq j \leq W), Square (i, j) is described by a character a_{i, j}.
If a_{i, j} is ., Square (i, j) is an empty square; if a_{i, j} is #, Square (i, j) is a wall square.
It is guaranteed that Squares (1, 1) and (H, W) are empty squares.

Taro will start from Square (1, 1) and reach (H, W) by repeatedly moving right or down to an adjacent empty square.

Find the number of Taro's paths from Square (1, 1) to (H, W).
As the answer can be extremely large, find the count modulo 10^9 + 7.

Constraints

H and W are integers.

2 \leq H, W \leq 1000

a_{i, j} is . or #.

Squares (1, 1) and (H, W) are empty squares.

Input

Input is given from Standard Input in the following format:

H W
a_{1, 1}\ldotsa_{1, W}
:
a_{H, 1}\ldotsa_{H, W}

Output

Print the number of Taro's paths from Square (1, 1) to (H, W), modulo 10^9 + 7.

Sample Input 1

3 4
...#
.#..
....

Sample Output 1

3

There are three paths as follows:

Sample Input 2

5 2
..
#.
..
.#
..

Sample Output 2

0

There may be no paths.

Sample Input 3

5 5
..#..
.....
#...#
.....
..#..

Sample Output 3

24

Sample Input 4

20 20
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................
....................

Sample Output 4

345263555

Be sure to print the count modulo 10^9 + 7.


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import qualified Data.Foldable as Foldable
import Data.List (unfoldr, foldl', sort, sortBy, (\\), delete, nub)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

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

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

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

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
swap (x, y) = (y, x)
pair (f, g) x = (f x, g x)
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

data Hisx f a x = Hisx { unHisx :: (a, f x) } deriving (Show, Functor)
newtype Cofree f a = Cf { unCf :: Fix (Hisx f a) }
instance Functor f => Functor (Cofree f) where
  fmap f = Cf . ana (phi . out) . unCf
    where phi (Hisx (a, x)) = Hisx (f a, x)

extract :: Functor f => Cofree f t -> t
extract cf = case out (unCf cf) of
  Hisx (a, _) -> a

sub :: Functor f => Cofree f a -> f (Cofree f a)
sub cf = case out (unCf cf) of
  Hisx (_, b) -> fmap Cf b

data Futx f a x = Futx { unFutx :: Either a (f x) } deriving (Show, Functor)
newtype Free f a = Fr { unFr :: Fix (Futx f a) }
instance Functor f => Functor (Free f) where
  fmap f = Fr . cata (In . phi) . unFr
    where phi (Futx (Left a)) = Futx (Left (f a))
          phi (Futx (Right x)) = Futx (Right x)

inject :: a -> Free f a
inject = Fr . In . Futx . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = phi . fmap (hylo phi psi) . psi -- cata phi . ana psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = In . fmap (meta phi psi) . out -- ana psi . cata phi
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata ap
  where ap = cast . Hisx . pair (phi, id)
        cast = Cf . In . fmap unCf
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana ap . inject
  where ap = uncurry either (psi, id) . unFutx . cast
        cast = fmap Fr . out . unFr
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = extract . hylo phi' psi' . inject
  where
    phi' = toCofree . Hisx . pair (phi, id)
    toCofree = Cf . In . fmap unCf
    psi' = uncurry either (psi, id) . unFutx . fromFree
    fromFree = fmap Fr . out . unFr
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

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

data NonEmptyListF a = NonEmptyListF (Int, [Int]) (Maybe a) deriving (Show, Functor)

type NonEmptyList = Fix NonEmptyListF
instance Show NonEmptyList where
  show (In (NonEmptyListF h Nothing)) = show h ++ ":[]"
  show (In (NonEmptyListF h (Just t))) = show h ++ ":" ++ show t

data Player = First | Second deriving (Show, Eq)

main = do
  (n:k:_) <- getInts
  xs <- getInts
  print $ bool Second First $ solve (sort xs) k

-- solve :: [Int] -> Int -> Bool
solve xs = dyna phi psi
  where
    psi 0 = NonEmptyListF (0, []) Nothing
    psi i = NonEmptyListF (i, takeWhile (>=0) $ map (i-) xs) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF Bool) -> Bool
    phi (NonEmptyListF _ Nothing) = False
    phi prev@(NonEmptyListF (i, bs) (Just t))
      | null bs = False
      | otherwise = back bs prev

    back :: [Int] -> NonEmptyListF (Cofree NonEmptyListF Bool) -> Bool
    back _ (NonEmptyListF _ Nothing) = False
    back [] (NonEmptyListF _ (Just t)) = False
    back kks@(k:ks) (NonEmptyListF (j, _) (Just t))
      | k+1 == j = extract t == False || back ks (sub t)
      | otherwise = back kks (sub t)

Score : 100 points

Problem Statement

There is a set A = \{ a_1, a_2, \ldots, a_N \} consisting of N positive integers.
Taro and Jiro will play the following game against each other.

Initially, we have a pile consisting of K stones.
The two players perform the following operation alternately, starting from Taro:

Choose an element x in A, and remove exactly x stones from the pile.

A player loses when he becomes unable to play.
Assuming that both players play optimally, determine the winner.

Constraints

All values in input are integers.

1 \leq N \leq 100

1 \leq K \leq 10^5

1 \leq a_1 < a_2 < \cdots < a_N \leq K

Input

Input is given from Standard Input in the following format:

N K
a_1 a_2 \ldots a_N

Output

If Taro will win, print First; if Jiro will win, print Second.

Sample Input 1

2 4
2 3

Sample Output 1

First

If Taro removes three stones, Jiro cannot make a move.
Thus, Taro wins.

Sample Input 2

2 5
2 3

Sample Output 2

Second

Whatever Taro does in his operation, Jiro wins, as follows:

If Taro removes two stones, Jiro can remove three stones to make Taro unable to make a move.

If Taro removes three stones, Jiro can remove two stones to make Taro unable to make a move.

Sample Input 3

2 7
2 3

Sample Output 3

First

Taro should remove two stones. Then, whatever Jiro does in his operation, Taro wins, as follows:

If Jiro removes two stones, Taro can remove three stones to make Jiro unable to make a move.

If Jiro removes three stones, Taro can remove two stones to make Jiro unable to make a move.

Sample Input 4

3 20
1 2 3

Sample Output 4

Second

Sample Input 5

3 21
1 2 3

Sample Output 5

First

Sample Input 6

1 100000
1

Sample Output 6

Second


import Control.Monad
import Control.Monad.ST
import Data.List
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as MV

main=do
    [n,k]<-map read.words<$>getLine::IO[Int]
    as<-map read.words<$>getLine::IO[Int]
    putStrLn $ ["Second", "First"] !! f k as

f k as = runST $ do
    kv <- MV.new (k+1) :: ST s (MV.STVector s Int)
    forM_ [0..k] $ \i -> do
        g <- fmap (gr.((-1):).sort) $ forM as $ \a -> if i-a>=0 then MV.read kv (i-a) else pure (-1)
        MV.write kv i g
    MV.read kv k

gr [a] = a+1
gr (a:b:x) | a+1>=b = gr (b:x) |otherwise = a+1


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.List
import qualified Data.IntSet as IS
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
import Debug.Trace
-- trace _ = id

solve :: Int -> Int -> [(Int,Int,Int)] -> Int
solve bN bM lras = runST $ do
    vec <- VUM.new (4*bN)
    recIntv <- VM.replicate (4*bN) IS.empty
    sgtAct_ mfInit vec bN 0 bN
    forM_ [0..bM-1] $ \i -> do
      let (l,r,a) = vLRA VU.! i
      sgtAct (mfAdd True a recIntv i) vec bN (l-1) r
    lpAct 0 0 vec recIntv
  where

  lpAct !ans !vSum vec recIntv = do
      (vMax, arg) <- sgtAct mfMax vec bN 0 bN
      removed <- sgtAct (mfRemove bN recIntv vLRA) vec bN arg (arg+1)
      if removed == 0 then return ans else
        lpAct (max ans (vSum + vMax)) (vSum + vMax) vec recIntv

  vLRA = VU.fromListN bM lras

mfInit SgtIn rc vec node l r = do
  VUM.write vec node (0, 0, l)
  when (l+1 < r) rc
mfInit _ _ _ _ _ _ = error "internal error"

mfAdd flag a recIntv i ft rc vec node l r = sub ft >> sgNodeInfo vec node where
  sub SgtIn = do
    VUM.modify vec (\(vSum,p,q) -> (vSum + a,p,q)) node
    if flag then VM.modify recIntv (IS.insert i) node
      else VM.modify recIntv (IS.delete i) node
  sub SgtOut = return ()
  sub SgtOther = do
    (m, ma) <- maxWithArg <$> rc
    VUM.modify vec (\(vSum,_,_) -> (vSum, m, ma)) node

mfMax SgtIn rc vec node l r = sgNodeInfo vec node
mfMax SgtOut rc vec node l r = return (minBound :: Int, -1)
mfMax SgtOther rc vec node l r = do
  (m, ma) <- maxWithArg <$> rc
  (vSum,_,_) <- VUM.read vec node
  return (vSum + m, ma)

mfRemove bN recIntv vLRA ft rc vec node l r = case ft of
  SgtIn -> sub
  SgtOut -> return 0
  SgtOther -> liftM2 (\(x,y) z -> x+y+z) rc sub
  where sub = do
          is <- VM.read recIntv node
          let len = IS.size is
          forM_ (IS.toList is) $ \i -> do
            let (l,r,a) = vLRA VU.! i
            sgtAct (mfAdd False (-a) recIntv i) vec bN (l-1) r
          return len

sgNodeInfo vec node = (\(s,m,a) -> (s+m,a)) <$> VUM.read vec node
maxWithArg ((m1,ma1), (m2,ma2)) = if m1 >= m2 then (m1,ma1) else (m2,ma2)

-- segment tree function type
data SgtFT = SgtIn | SgtOut | SgtOther deriving(Show)

sgtAct :: forall m a b. (PrimMonad m, VUM.Unbox a) =>
          (SgtFT -> m (b,b) ->
             VUM.MVector (PrimState m) a -> Int -> Int -> Int -> m b) ->
          VUM.MVector (PrimState m) a ->
          Int ->
          Int ->
          Int ->
          m b
sgtAct mf vec n left right = sub 0 0 n where
  sub :: Int -> Int -> Int -> m b
  sub node l r =
    mf (sgtft left right l r) (sgtChildAct sub node l r) vec node l r

sgtAct_ :: (PrimMonad m, VUM.Unbox a) =>
           (SgtFT -> m () ->
              VUM.MVector (PrimState m) a -> Int -> Int -> Int -> m ()) ->
           VUM.MVector (PrimState m) a ->
           Int ->
           Int ->
           Int ->
           m ()
sgtAct_ mf vec n left right = sub 0 0 n where
  sub node l r =
    mf (sgtft left right l r) (sgtChildAct_ sub node l r) vec node l r

sgtChildAct :: (Monad m) =>
               (Int -> Int -> Int -> m b) -> Int -> Int -> Int -> m (b,b)
sgtChildAct rc' node l r =
  let mid = (l + r) `div` 2
  in (,) <$> rc' (2*node + 1) l mid <*> rc' (2*node + 2) mid r

sgtChildAct_ :: (Monad m) =>
               (Int -> Int -> Int -> m ()) -> Int -> Int -> Int -> m ()
sgtChildAct_ rc' node l r = sgtChildAct rc' node l r >> return ()

sgtft :: Int -> Int -> Int -> Int -> SgtFT
sgtft left right l r
  | left <= l && r <= right = SgtIn
  | r <= left || right <= l = SgtOut
  | otherwise               = SgtOther

traceL :: Show a => String -> a -> b -> b
traceL label showObj val = trace (label ++ " " ++ show showObj) val

traceLM :: (Monad m, Show a) => String -> (b -> a) -> m b -> m b
traceLM label showFn act = do
  aaa <- act
  traceL label (showFn aaa) (return ())
  return aaa

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> Int
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_bN,bs_bM]:remLines1 = remLines0
      bN = readBInt bs_bN
      bM = readBInt bs_bM
      lras = map (\[x1,x2,x3] -> (readBInt x1,readBInt x2,readBInt x3)) remLines1
  in solve bN bM lras

outAnswer :: Int -> IO ()
outAnswer = putStrLn . show

main :: IO ()
main = outAnswer . tmain =<< B.getContents

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

inp1 = "5 3\n1 3 10\n2 4 -10\n3 5 10\n"
inp2 = "3 4\n1 3 100\n1 1 -10\n2 2 -20\n3 3 -30\n"
inp3 = "1 1\n1 1 -10\n"
inp4 = "1 5\n1 1 1000000000\n1 1 1000000000\n1 1 1000000000\n1 1 1000000000\n1 1 1000000000\n"
inp5 = "6 8\n5 5 3\n1 1 10\n1 6 -8\n3 6 5\n3 4 9\n5 5 -2\n1 3 -6\n4 6 -7\n"
tv1 = tmain $ B.pack inp1
tv2 = tmain $ B.pack inp2
tv3 = tmain $ B.pack inp3
tv4 = tmain $ B.pack inp4
tv5 = tmain $ B.pack inp5
test1 = tv1 == 20
test2 = tv2 == 90
test3 = tv3 == 0
test4 = tv4 == 5000000000
test5 = tv5 == 10
alltest = test1 && test2 && test3 && test4 && test5

Score : 100 points

Problem Statement

Consider a string of length N consisting of 0 and 1.
The score for the string is calculated as follows:

For each i (1 \leq i \leq M), a_i is added to the score if the string contains 1 at least once between the l_i-th and r_i-th characters (inclusive).

Find the maximum possible score of a string.

Constraints

All values in input are integers.

1 \leq N \leq 2 × 10^5

1 \leq M \leq 2 × 10^5

1 \leq l_i \leq r_i \leq N

|a_i| \leq 10^9

Input

Input is given from Standard Input in the following format:

N M
l_1 r_1 a_1
l_2 r_2 a_2
:
l_M r_M a_M

Output

Print the maximum possible score of a string.

Sample Input 1

5 3
1 3 10
2 4 -10
3 5 10

Sample Output 1

20

The score for 10001 is a_1 + a_3 = 10 + 10 = 20.

Sample Input 2

3 4
1 3 100
1 1 -10
2 2 -20
3 3 -30

Sample Output 2

90

The score for 100 is a_1 + a_2 = 100 + (-10) = 90.

Sample Input 3

1 1
1 1 -10

Sample Output 3

0

The score for 0 is 0.

Sample Input 4

1 5
1 1 1000000000
1 1 1000000000
1 1 1000000000
1 1 1000000000
1 1 1000000000

Sample Output 4

5000000000

The answer may not fit into a 32-bit integer type.

Sample Input 5

6 8
5 5 3
1 1 10
1 6 -8
3 6 5
3 4 9
5 5 -2
1 3 -6
4 6 -7

Sample Output 5

10

For example, the score for 101000 is a_2 + a_3 + a_4 + a_5 + a_7 = 10 + (-8) + 5 + 9 + (-6) = 10.


main = do
    n <- getLine
    print $ foldl cnt 0 n

cnt :: Int -> Char -> Int
cnt n x = if x == '2' then n + 1 else n

Score : 100 points

Problem Statement

You are given an integer N that has exactly four digits in base ten.
How many times does 2 occur in the base-ten representation of N?

Constraints

1000 \leq N \leq 9999

Input

Input is given from Standard Input in the following format:

N

Output

Print the answer.

Sample Input 1

1222

Sample Output 1

3

2 occurs three times in 1222. By the way, this contest is held on December 22 (JST).

Sample Input 2

3456

Sample Output 2

0

Sample Input 3

9592

Sample Output 3

1


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

main :: IO ()
main = readLine >>= print . solve

solve :: [Int] -> Int
solve [n, p]
    | n == 1 || p == 1 = p
    | otherwise = pf 1 [2..] n p

pf :: Int -> [Int] -> Int -> Int -> Int
pf acc (x : xs) n p
    | p == 1 = acc
    | y == 0 = pf acc xs n q
    | otherwise = pf (acc * (x ^ y)) xs n q
    where
        y = z `div` n
        (q, z) = count p x

count :: Int -> Int -> (Int, Int)
count v x = loop 0 m
    where
        m = truncate . succ . logBase (fromIntegral x) $ fromIntegral v
        loop b t
            | t - b < 2 = (v `div` bv, b)
            | v `mod` hv == 0 = loop h t
            | otherwise = loop b h
            where
                h = (b + t) `div` 2
                bv = x ^ b
                hv = x ^ h

readLine :: IO [Int]
readLine = unfoldr (\s -> second (maybe B.empty snd . B.uncons) <$> B.readInt s) <$> B.getLine

readContents :: Int -> IO [[Int]]
readContents = flip replicateM readLine

Score : 300 points

Problem Statement

There are N integers a_1, a_2, ..., a_N not less than 1.
The values of a_1, a_2, ..., a_N are not known, but it is known that a_1 \times a_2 \times ... \times a_N = P.

Find the maximum possible greatest common divisor of a_1, a_2, ..., a_N.

Constraints

1 \leq N \leq 10^{12}

1 \leq P \leq 10^{12}

Input

Input is given from Standard Input in the following format:

N P

Output

Print the answer.

Sample Input 1

3 24

Sample Output 1

2

The greatest common divisor would be 2 when, for example, a_1=2, a_2=6 and a_3=2.

Sample Input 2

5 1

Sample Output 2

1

As a_i are positive integers, the only possible case is a_1 = a_2 = a_3 = a_4 = a_5 = 1.

Sample Input 3

1 111

Sample Output 3

111

Sample Input 4

4 972439611840

Sample Output 4

206


import qualified Data.Map.Strict as Map

primeFactorize :: Integer -> [Integer]
primeFactorize 1 = []
primeFactorize x =
    let v = head $ nativeFactors x in
        v : primeFactorize (x `div` v)
    where
        nativeFactors n = [a | a <- [2..n], n `mod` a == 0]

toCountMap :: (Ord k, Integral a) => [k] -> Map.Map k a
toCountMap xs = Map.fromListWith (+) $ zip xs (repeat 1)

main :: IO ()
main = do
    (n:p:_) <- fmap (map read . words) getLine :: IO[Integer]
    print $ solve n p

solve :: Integer -> Integer -> Integer
solve n p =
    let ps = Map.toList $ toCountMap $ primeFactorize p
    in foldr (\ (x, e) total -> total * (x ^ (e `div` n))) 1 ps


main = do
  (n:p:xs) <- (map read) . words <$> getLine
  putStrLn . show $ solve n p

solve :: Integer -> Integer -> Integer
solve num p = calcFactors num p primeList
  where
    calcFactors :: Integer -> Integer -> [Integer] -> Integer
    calcFactors n 1 primes = 1
    calcFactors n prod (pr:primes) =
      let nd = nDiv prod pr
      in if pr * n > prod || (pr^2 > p) then 1 else
        (pr ^ (nd `div` n)) * (calcFactors n (prod `div` (pr^nd)) primes)

nDiv x pr = if x `mod` pr == 0 then 1 + (nDiv (x `div` pr) pr) else 0

--primeList :: Integral a => a
primeList = 2 : prime'
prime' = 3 : 5 : 7 : (siege 3 prime')
siege m (a:b:xs) = [n|n<-[a^2,a^2+2..b^2-2],gcd n m<2] ++ (siege (m*b) (b:xs))


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.List
-- import qualified Data.Vector.Unboxed as VU
-- import qualified Data.Vector.Unboxed.Mutable as VUM
-- import Control.Monad
-- import Control.Monad.ST
-- import Debug.Trace
trace _ = id

solve :: Int -> [Int] -> Int
solve n as = answer
  where
  posLst :: [Int]
  posLst = trace ("posLst " ++ show posLst0) posLst0
  posLst0 = costLst as
  negLst :: [Int]
  negLst = trace ("negLst " ++ show negLst0) negLst0
  negLst0 = reverse $ costLst $ reverse as
  answer = minimum $ zipWith3 f posLst negLst [0,1..]
    where f p n w = 2 * (p + n) + w

costLst :: [Int] -> [Int]
costLst xs = scanr (+) 0 $ snd $ mapAccumR f initAcc $
                zip xs (tail xs ++ [big])
  where
    initAcc :: [(Int, Int)]
    initAcc = [(0, big)]
    f :: [(Int,Int)] -> (Int,Int) -> ([(Int,Int)], Int)
    f steps@((len, gap):rem) (x, xNext)
      | 4 * x <= xNext = ((1, costF xNext x):steps, 0)
      | x <= xNext = ((len+1, gap):rem, 0)
      | otherwise = g (costC x xNext) 0 1 steps
      where
        g :: Int -> Int -> Int -> [(Int,Int)] -> ([(Int,Int)], Int)
        g !h !cost !len ((tLen,gap):rem)
          | h <= gap = ((newLen, gap-h):rem, newCost)
          | otherwise = g (h-gap) newCost newLen rem
          where newCost = cost + h*tLen
                newLen = len + tLen

big = 10 ^ 10

epsilon = 2 ** (-64)

log4 :: Int -> Double
log4 x = logBase 4 (fromIntegral x)

costC x y = ceiling (log4 x - log4 y - epsilon)
costF x y = floor (log4 x - log4 y + epsilon)

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> Int
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_n]:remLines1 = remLines0
      n = readBInt bs_n
      line2:remLines2 = remLines1
      as = map readBInt line2
  in solve n as

outAnswer :: Int -> IO ()
outAnswer = putStrLn . show

main :: IO ()
main = outAnswer . tmain =<< B.getContents

Score : 800 points

Problem Statement

There are N positive integers A_1, A_2, ..., A_N.
Takahashi can perform the following operation on these integers any number of times:

Choose 1 \leq i \leq N and multiply the value of A_i by -2.

Notice that he multiplies it by minus two.

He would like to make A_1 \leq A_2 \leq ... \leq A_N holds.
Find the minimum number of operations required. If it is impossible, print -1.

Constraints

1 \leq N \leq 200000

1 \leq A_i \leq 10^9

Input

Input is given from Standard Input in the following format:

N
A_1 A_2 ... A_N

Output

Print the answer.

Sample Input 1

4
3 1 4 1

Sample Output 1

3

One possible solution is:

Choose i=4 and multiply the value of A_4 by -2. A_1, A_2, A_3, A_4 are now 3, 1, 4, -2.

Choose i=1 and multiply the value of A_1 by -2. A_1, A_2, A_3, A_4 are now -6, 1, 4, -2.

Choose i=4 and multiply the value of A_4 by -2. A_1, A_2, A_3, A_4 are now -6, 1, 4, 4.

Sample Input 2

5
1 2 3 4 5

Sample Output 2

0

A_1 \leq A_2 \leq ... \leq A_N holds before any operation is performed.

Sample Input 3

8
657312726 129662684 181537270 324043958 468214806 916875077 825989291 319670097

Sample Output 3

7


import Data.List
import Data.Char

differ :: Int -> [Int] -> Int
differ k l = dif (eval c) c (drop k sl) where
    sl = sort l
    c  = newCursor (take k sl) (k-1)
    dif m cl []
        | (eval cl) < m = eval cl
        | otherwise     = m
    dif m cl (x:xs)
        | d < m     = dif d (shift x cl) xs
        | otherwise = dif m (shift x cl) xs
        where
            d  = eval cl

data Cursor a = Cursor [a] [a] deriving (Show)

newCursor :: [a] -> Int -> Cursor a
newCursor l k = Cursor (take k l) (drop k l)

shift :: a -> Cursor a -> Cursor a
shift a (Cursor [_] r) = Cursor (reverse r) [a]
shift a (Cursor (f:fs) r) = Cursor fs (a:r)

eval :: Cursor Int -> Int
eval (Cursor (f:fs) (r:rs)) = r - f

readData :: Int -> IO [Int]
readData 0 = return []
readData n = do
    stX <- getLine
    let x = read stX :: Int
    fmap (x:) $ readData (n-1)

main :: IO()
main = do
    line1 <- getLine
    let [stN, stK] = words line1
        n = read stN :: Int
        k = read stK :: Int
    l <- readData n
    let ans = differ k l
    print ans

Score : 300 points

Problem Statement

In some other world, today is Christmas Eve.

There are N trees planted in Mr. Takaha's garden. The height of the i-th tree (1 \leq i \leq N) is h_i meters.

He decides to choose K trees from these trees and decorate them with electric lights. To make the scenery more beautiful, the heights of the decorated trees should be as close to each other as possible.

More specifically, let the height of the tallest decorated tree be h_{max} meters, and the height of the shortest decorated tree be h_{min} meters. The smaller the value h_{max} - h_{min} is, the better. What is the minimum possible value of h_{max} - h_{min}?

Constraints

2 \leq K < N \leq 10^5

1 \leq h_i \leq 10^9

h_i is an integer.

Input

Input is given from Standard Input in the following format:

N K
h_1
h_2
:
h_N

Output

Print the minimum possible value of h_{max} - h_{min}.

Sample Input 1

5 3
10
15
11
14
12

Sample Output 1

2

If we decorate the first, third and fifth trees, h_{max} = 12, h_{min} = 10 so h_{max} - h_{min} = 2. This is optimal.

Sample Input 2

5 3
5
7
5
7
7

Sample Output 2

0

If we decorate the second, fourth and fifth trees, h_{max} = 7, h_{min} = 7 so h_{max} - h_{min} = 0. This is optimal.

There are not too many trees in these sample inputs, but note that there can be at most one hundred thousand trees (we just can't put a sample with a hundred thousand lines here).


import Data.List

main = do
    [n, k] <- map read . words <$> getLine
    hs <- map read <$> (sequence $ replicate n getLine)
    let hs' = sort hs
    let mms = zip hs' (drop (k - 1) hs')
    let diffs = map (\(x, y) -> y - x) mms
    print $ minimum diffs


nagosan::String->String
nagosan d
    | d == "3" || d == "5" || d ==  "7" = "Yes"
    | otherwise = "No"

main::IO ()
main = do
    d <- getLine
    putStrLn $ nagosan d

Score : 100 points

Problem Statement

Shichi-Go-San (literally "Seven-Five-Three") is a traditional event in a certain country to celebrate the growth of seven-, five- and three-year-old children.

Takahashi is now X years old. Will his growth be celebrated in Shichi-Go-San this time?

Constraints

1 ≤ X ≤ 9

X is an integer.

Input

Input is given from Standard Input in the following format:

X

Output

If Takahashi's growth will be celebrated, print YES; if it will not, print NO.

Sample Input 1

5

Sample Output 1

YES

The growth of a five-year-old child will be celebrated.

Sample Input 2

6

Sample Output 2

NO

See you next year.


main = do
  x <- getLine
  putStrLn $ sitigo (read x)

sitigo :: Int -> String
sitigo 3 = "YES"
sitigo 5 = "YES"
sitigo 7 = "YES"
sitigo _ = "NO"


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

readString = map BS.unpack . BS.words

getString = readString <$> BS.getLine

calc :: String -> [Int]
calc s | length s >= 3 = abs ((read (take 3 s) :: Int) - 753) : calc (tail s)
       | otherwise = []

main = do
  [s] <- getString
  print $ minimum (calc s)

Score : 200 points

Problem Statement

There is a string S consisting of digits 1, 2, ..., 9.
Lunlun, the Dachshund, will take out three consecutive digits from S, treat them as a single integer X and bring it to her master. (She cannot rearrange the digits.)

The master's favorite number is 753. The closer to this number, the better.
What is the minimum possible (absolute) difference between X and 753?

Constraints

S is a string of length between 4 and 10 (inclusive).

Each character in S is 1, 2, ..., or 9.

Input

Input is given from Standard Input in the following format:

S

Output

Print the minimum possible difference between X and 753.

Sample Input 1

1234567876

Sample Output 1

34

Taking out the seventh to ninth characters results in X = 787, and the difference between this and 753 is 787 - 753 = 34. The difference cannot be made smaller, no matter where X is taken from.

Note that the digits cannot be rearranged. For example, taking out 567 and rearranging it to 765 is not allowed.

We cannot take out three digits that are not consecutive from S, either. For example, taking out the seventh digit 7, the ninth digit 7 and the tenth digit 6 to obtain 776 is not allowed.

Sample Input 2

35753

Sample Output 2

0

If 753 itself can be taken out, the answer is 0.

Sample Input 3

1111111111

Sample Output 3

642

No matter where X is taken from, X = 111, with the difference 753 - 111 = 642.


main :: IO ()
main = do
  n <- readLn
  print $ solve n

solve :: Int -> Int
solve n = minimum cs
  where
    cs = map (\x -> abs (x - 753))
      $ filter (>110) [ n `div` m `mod` 1000 | m <- (map (10^) [0..10]) ]


import Data.List
import Data.Char
import Control.Monad
import Data.Ord

gen n = [read x|i<-[3..n],x<-sequence $ replicate i "753",null $ "753" \\ x]

main = do
  n <- readLn::IO Int
  let aa = takeWhile (<= n) $ gen $ length $ show n
  putStrLn $ show $ length aa

Score : 300 points

Problem Statement

You are given an integer N. Among the integers between 1 and N (inclusive), how many Shichi-Go-San numbers (literally "Seven-Five-Three numbers") are there?

Here, a Shichi-Go-San number is a positive integer that satisfies the following condition:

When the number is written in base ten, each of the digits 7, 5 and 3 appears at least once, and the other digits never appear.

Constraints

1 \leq N < 10^9

N is an integer.

Input

Input is given from Standard Input in the following format:

N

Output

Print the number of the Shichi-Go-San numbers between 1 and N (inclusive).

Sample Input 1

575

Sample Output 1

4

There are four Shichi-Go-San numbers not greater than 575: 357, 375, 537 and 573.

Sample Input 2

3600

Sample Output 2

13

There are 13 Shichi-Go-San numbers not greater than 3600: the above four numbers, 735, 753, 3357, 3375, 3537, 3557, 3573, 3575 and 3577.

Sample Input 3

999999999

Sample Output 3

26484