{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Char (ord, isDigit)
import Data.Bits
import Data.Int
import Data.List
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as B
import System.IO (stdin)

readIONat :: (Bits a, Integral a) => IO a
readIONat = do
  let reader ch = fromIntegral $ ord ch - ord '0'

  digit0 <- fix
    (\(!f) (!_) -> do
      ch <- fmap B.head $ B.hGetSome stdin 1
      if isDigit ch then let ch' = reader ch in ch' `seq` return ch' else f ch
    )
    ' '
  flip fix (return digit0) $ \(!f) (!acc) -> do
    s <- B.hGetSome stdin 1
    if B.null s || not (isDigit (B.head s))
      then acc
      else do
        a <- acc
        let a' = shiftL a 1 + shiftL a 3 + reader (B.head s) in a' `seq` f (return a)

solve :: Int -> VU.Vector Int16 -> Int32
solve n hs = fst dp
 where
  -- dp[i]: minimal cost of moving from 1st to i-th place
  dp :: (Int32, Int32)
  dp = VU.foldl'
    (\(!dp1, !dp2) (!i, !v) -> if i == 0
      then (0, dp1)
      else if i == 1
        then (dp1 + abs (fromIntegral $ v - hs VU.! 0), dp1)
        else
          ( min (dp1 + abs (fromIntegral $ v - hs VU.! (i - 1)))
                (dp2 + abs (fromIntegral $ v - hs VU.! (i - 2)))
          , dp1
          )
    )
    (-1, -1)
    (VU.indexed hs)

main = do
  n  <- readIONat
  hs <- VU.replicateM n readIONat
  print $ solve n hs


{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Char (ord, isDigit)
import Data.Bits
import Data.Int
import Data.List
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as B
import System.IO (stdin)

readIONat :: (Bits a, Integral a) => IO a
readIONat = do
  let reader ch = fromIntegral $ ord ch - ord '0'

  digit0 <- fix
    (\(!f) (!_) -> do
      ch <- fmap B.head $ B.hGetSome stdin 1
      if isDigit ch then return (reader ch) else f ch
    )
    ' '
  flip fix (return digit0) $ \(!f) (!acc) -> do
    s <- B.hGetSome stdin 1
    if B.null s || not (isDigit (B.head s))
      then acc
      else do
        a <- acc
        f (return $ shiftL a 1 + shiftL a 3 + reader (B.head s))

solve :: Int -> VU.Vector Int16 -> Int32
solve n hs = fst dp
 where
  -- dp[i]: minimal cost of moving from 1st to i-th place
  dp :: (Int32, Int32)
  dp = VU.foldl'
    (\(!dp1, !dp2) (!i, !v) -> if i == 0
      then (0, dp1)
      else if i == 1
        then (dp1 + abs (fromIntegral $ v - hs VU.! 0), dp1)
        else
          ( min (dp1 + abs (fromIntegral $ v - hs VU.! (i - 1)))
                (dp2 + abs (fromIntegral $ v - hs VU.! (i - 2)))
          , dp1
          )
    )
    (-1, -1)
    (VU.indexed hs)

main = do
  n  <- readIONat
  hs <- VU.replicateM n readIONat
  print $ solve n hs

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

Score : 100 points

Problem Statement

There are N stones, numbered 1, 2, \ldots, N.
For each i (1 \leq i \leq N), the height of Stone i is h_i.

There is a frog who is initially on Stone 1.
He will repeat the following action some number of times to reach Stone N:

If the frog is currently on Stone i, jump to Stone i + 1 or Stone i + 2. Here, a cost of |h_i - h_j| is incurred, where j is the stone to land on.

Find the minimum possible total cost incurred before the frog reaches Stone N.

Constraints

All values in input are integers.

2 \leq N \leq 10^5

1 \leq h_i \leq 10^4

Input

Input is given from Standard Input in the following format:

N
h_1 h_2 \ldots h_N

Output

Print the minimum possible total cost incurred.

Sample Input 1

4
10 30 40 20

Sample Output 1

30

If we follow the path 1 → 2 → 4, the total cost incurred would be |10 - 30| + |30 - 20| = 30.

Sample Input 2

2
10 10

Sample Output 2

0

If we follow the path 1 → 2, the total cost incurred would be |10 - 10| = 0.

Sample Input 3

6
30 10 60 10 60 50

Sample Output 3

40

If we follow the path 1 → 3 → 5 → 6, the total cost incurred would be |30 - 60| + |60 - 60| + |60 - 50| = 40.

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 #-}
import Control.Arrow
import Data.Int
import Data.List
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as B

solve :: Int -> [Int16] -> Int32
solve n hs = 0

main = do
  let sillyTail b | B.null b  = b
                  | otherwise = B.tail b
  let readInt :: Integral a => B.ByteString -> Maybe (a, B.ByteString)
      readInt b
        | B.null b = Nothing
        | otherwise = fmap (first fromIntegral . second sillyTail) $ B.readInt b

  n  <- (\vec -> (vec VU.! 0)) . VU.unfoldrN 1 readInt <$> B.getLine
  hs <- unfoldr readInt <$> B.getLine
  print $ solve n hs


{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Data.Int
import Data.Foldable
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as B

solve :: Int -> VU.Vector Int16 -> Int32
solve n hs = head dp
 where
  -- dp[i]: minimal cost of moving from 1st to i-th place
  dp :: [Int32]
  dp = VU.foldl'
    (\(!dp) (!i, !v) -> if i == 0
      then 0 : dp
      else if i == 1
        then (head dp + abs (fromIntegral $ v - hs VU.! 0)) : dp
        else
          let (d1 : d2 : _) = dp
          in  (min (d1 + abs (fromIntegral $ v - hs VU.! (i - 1)))
                   (d2 + abs (fromIntegral $ v - hs VU.! (i - 2)))
              )
                : dp
    )
    []
    (VU.indexed hs)

main = do
  let readInt :: Integral a => B.ByteString -> Maybe (a, B.ByteString)
      readInt = fmap (first fromIntegral . second B.tail) . B.readInt

  n  <- (\vec -> (vec VU.! 0)) . VU.unfoldrN 1 readInt <$> B.getLine
  hs <- VU.unfoldrN n readInt <$> B.getLine
  print $ solve n hs


import Control.Arrow
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Monad.State (State, evalState, runState, put, gets, modify)
import Data.Map.Strict (Map, lookup, insert, empty)

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

solve :: [Int] -> Int
solve = evalMemo calc

calc :: Memoizer [Int] Int -> Memoizer [Int] Int
calc f (w : x : y : zs) = min <$> res1 <*> res2
    where
        res1 = ((abs $ w - x) +) <$> f (x : y : zs)
        res2 = ((abs $ w - y) +) <$> f (y : zs)
calc _ [x, y] = return . abs $ x - y
calc _ _ = return 0

type Memoizer a b = a -> State (Map a b) b

evalMemo :: (Ord a) => (Memoizer a b -> Memoizer a b) -> a -> b
evalMemo f = flip evalState empty . memoizeFix f

runMemo :: (Ord a) => (Memoizer a b -> Memoizer a b) -> a -> (b, Map a b)
runMemo f = flip runState empty . memoizeFix f

memoizeFix :: (Ord a) => (Memoizer a b -> Memoizer a b) -> Memoizer a b
memoizeFix f x = gets (Data.Map.Strict.lookup x) >>= maybe (f (memoizeFix f) x >>= ((<$) <*> (modify . Data.Map.Strict.insert x))) return

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


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IMS
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Control.Monad
import Control.Monad.ST
-- import Control.Monad.ST.Safe
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import System.IO
import Data.Function
import Control.Monad.Primitive
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Generic.Mutable as VGM
import Data.STRef

main :: IO ()
main = do
  n <- read <$> getLine
  hs <- VU.unfoldrN n (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  print $ query hs

query :: VU.Vector Int -> Int
query vec = loop 2 (abs $ vec VU.! 0 - vec VU.! 1) 0
  where
  -- The flog is at k
    loop !k !cost_km1 !cost_km2
      | k >= VU.length vec = cost_km1
      | otherwise =
        loop (k+1) (min (cost_km1 + abs (vec VU.! k - vec VU.! (k-1)))
                        (cost_km2 + abs (vec VU.! k - vec VU.! (k-2))))
                   cost_km1


{-# LANGUAGE BangPatterns #-}
import           Control.Monad
import           Control.Monad.State
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.List
import qualified Data.Vector.Unboxed         as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

main :: IO ()
main = do
  [n,k] <- readLnAsListWith unconsInt
  hvec <- readLnAsUVecWith unconsInt n

  print $ VU.last $ solve4 n k hvec

  return ()

-- mutable vector を使うバージョン（貰うDP）
solve1 :: Int -> Int -> VU.Vector Int -> VU.Vector Int
solve1 n k hvec = VU.create $ do
  dp <- VUM.replicate n 0
  forM_ [0..n-1] $ \i -> case i of
    0 -> VUM.write dp 0 0
    _ -> forM [(max (i-k) 0)..(i-1)] (\j -> liftM2 (+) (VUM.read dp j) (return . abs $ hvec VU.! i - hvec VU.! j)) >>=  VUM.write dp i . minimum
  return dp

-- 貰うDPをimmutable vectorで構成するバージョン
-- 構築済DPテーブルから次のテーブルを構築するので、constructNを使用する
-- https://atcoder.jp/contests/dp/submissions/5209611 を元に、微修正
solve2 :: Int -> Int -> VU.Vector Int -> VU.Vector Int
solve2 n k hvec = VU.constructN n $ \dp ->
  if VU.null dp
  then 0
  else let !i = VU.length dp
           !h_i = hvec VU.! i
       in VU.minimum $ VU.map (\(dp_j, h_j) -> dp_j + abs (h_i - h_j)) $ VU.drop (i-k) $ VU.zip dp hvec

-- h:  0 ------- i-k ------ i-1 -- i ---- n-1

--     (drop)
-- dp: 0 ------- i-k ------ i-1
--     |-- drop --|-- k<=i --|

--     (no drop)
-- dp: 0 ------ i-1 --------------------- n-1
--     |-- i<k --|

-- 配るDP
solve3 :: Int -> Int -> VU.Vector Int -> VU.Vector Int
solve3 n k hvec = VU.create $ do
  dp <- VUM.replicate n maxBound
  VUM.write dp 0 0
  forM_ [0..n-1] $ \i -> forM [(i+1)..(min (i+k) n-1)] $ \j -> do
    a <- liftM2 (+) (VUM.read dp i) (return . abs $ hvec VU.! i - hvec VU.! j)
    p <- VUM.read dp j
    VUM.write dp j $ min a p
  return dp

-- 配るDPをimmutable vectorで構成するバージョン
-- 今の状態から新規のDPテーブルを構築すると考えて、generateを使用する
solve4 :: Int -> Int -> VU.Vector Int -> VU.Vector Int
solve4 n k hvec = go 1 (0 `VU.cons` VU.replicate (k-1) maxBound)
  where go :: Int -> VU.Vector Int -> VU.Vector Int
        go m dp | m == n = dp
                | otherwise =
                    let dplen = min k (n-m)
                        h' = VU.drop (m-1) hvec
                    in go (m+1) $ VU.generate dplen $ \j ->
                      if j == k-1
                      then (dp VU.! 0 + abs (h' VU.! (j+1) - h' VU.! 0))
                      else (dp VU.! 0 + abs (h' VU.! (j+1) - h' VU.! 0)) `min` (dp VU.! (j+1))

-- h:  0 --- m-1 -- m ---- m+j ---- m+k-2 -- m+k-1 ---- n-1
-- (drop)     0 --- 1 ---- j+1 ----- k-1 ----- k ------ n-m
-- dp0:       0 --- 1 ---- j+1 ----- k-1
-- dp1:             0 ----- j ------ k-2 ---- k-1

-- n = 13
-- k = 9
--         |--- 13 ----|
-- h:      ooooooooooooo
-- m = 1    |-- 9 --|     k
-- -> dp:   ooooooooo
-- m = 2     |-- 9 --|    k
-- -> dp:    ooooooooo
-- m = 3      |-- 9 --|   k
-- -> dp:     ooooooooo
-- m = 4       |-- 9 --|  k==n-m
-- -> dp:      ooooooooo
-- m = 5        |- 8 --|  n-m
-- -> dp:       oooooooo
-- m = 6         |- 7 -|  n-m
-- -> dp:        ooooooo
-- m = 7          | 6 -|  n-m
-- -> dp:         oooooo
-- m = 8           | 5 |  n-m
-- -> dp:          ooooo
-- m = 9            |4 |  n-m
-- -> dp:           oooo
-- m = 10            |3|  n-m
-- -> dp:            ooo
-- m = 11             ||  n-m
-- -> dp:             oo
-- m = 12              1  n-m
-- -> dp:              o

unconsInt :: StateT BS.ByteString Maybe Int
unconsInt = StateT $ BS.readInt . BS.dropWhile isSpace

readLnAsListWith :: StateT BS.ByteString Maybe a -> IO [a]
readLnAsListWith !st = unfoldr (runStateT st) <$> BS.getLine

readLnAsUVecWith :: VU.Unbox a => StateT BS.ByteString Maybe a -> Int -> IO (VU.Vector a)
readLnAsUVecWith !st !n = VU.unfoldrN n (runStateT st) <$> BS.getLine

Score : 100 points

Problem Statement

There are N stones, numbered 1, 2, \ldots, N.
For each i (1 \leq i \leq N), the height of Stone i is h_i.

There is a frog who is initially on Stone 1.
He will repeat the following action some number of times to reach Stone N:

If the frog is currently on Stone i, jump to one of the following: Stone i + 1, i + 2, \ldots, i + K. Here, a cost of |h_i - h_j| is incurred, where j is the stone to land on.

Find the minimum possible total cost incurred before the frog reaches Stone N.

Constraints

All values in input are integers.

2 \leq N \leq 10^5

1 \leq K \leq 100

1 \leq h_i \leq 10^4

Input

Input is given from Standard Input in the following format:

N K
h_1 h_2 \ldots h_N

Output

Print the minimum possible total cost incurred.

Sample Input 1

5 3
10 30 40 50 20

Sample Output 1

30

If we follow the path 1 → 2 → 5, the total cost incurred would be |10 - 30| + |30 - 20| = 30.

Sample Input 2

3 1
10 20 10

Sample Output 2

20

If we follow the path 1 → 2 → 3, the total cost incurred would be |10 - 20| + |20 - 10| = 20.

Sample Input 3

2 100
10 10

Sample Output 3

0

If we follow the path 1 → 2, the total cost incurred would be |10 - 10| = 0.

Sample Input 4

10 4
40 10 20 70 80 10 20 70 80 60

Sample Output 4

40

If we follow the path 1 → 4 → 8 → 10, the total cost incurred would be |40 - 70| + |70 - 70| + |70 - 60| = 40.


import qualified Data.ByteString.Char8 as B
import           Data.Graph.Inductive
import           Data.List

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  hs <- unfoldr (B.readInt . B.dropWhile (== ' ')) <$> B.getLine
  print $ solve n k hs

solve :: Int -> Int -> [Int] -> Int
solve n k hs = spLength 1 n gr
  where
    gr = mkGraph ns es :: Gr () Int
    ns = [ (i, ()) | i <- [1..n] ]
    es = [ (i, i+j, abs (h0-h1)) | j <- [1..k], (i,h0,h1) <- zip3 [1..] hs (drop j hs) ]


import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.List
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

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

main = do
    [n, k] <- getIntList
    hs <- VU.fromList <$> getIntList
    dp <- VUM.replicate n (10^9)
    VUM.write dp 0 0
    forM_ [0..n-1] $ \i -> do
        forM_ [1..(min k (n - i - 1))] $ \j -> do
            let dk = abs $ (hs VU.! (i + j)) - (hs VU.! i)
            next <- VUM.read dp (i + j)
            now <- VUM.read dp i
            VUM.write dp (i + j) $ min next (now + dk)
    ans <- VUM.read dp (n - 1)
    print ans


import Data.Vector
import Data.Maybe

main = do
    [i, k] <- fmap read . words<$> getLine
    ns <- fromList . fmap read . words <$> getLine
    putStrLn . show $ cost k (i - 1) ns

cost :: Int -> Int -> Vector Int -> Int
cost k j ns = memo ! j
    where
        memo = fromList [cost' l ns | l <- [0..j]]
        cost' :: Int -> Vector Int -> Int
        cost' 0 ns = 0
        cost' 1 ns = abs $ ns ! 0 - ns ! 1
        cost' i ns = Prelude.minimum memo'
            where
              memo' = fromList $ catMaybes [case memo !? (i - m) of
                                  Just x -> Just $ x + abs (ns ! (i - m) - ns ! i)
                                  Nothing -> Nothing
                                | m <- [1..k]]


import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Data.Char

solve :: VU.Vector Int -> Int -> Int -> Int
solve hs n k =
  runST $ do
    dp <- VUM.replicate (n+1) (10^5)
    VUM.write dp 0 0
    forM_ [1..n-1] $ \now -> do
      xs <- forM [now-k,now-k+1..now-1] $ \prev ->
              if prev >= 0 then do
                n <- VUM.read dp prev
                let diff = abs $ (hs VU.! now) - (hs VU.! prev)
                return $ n + diff
              else
                return $ 10^9
      let x = minimum xs
      VUM.write dp now x
    VUM.read dp (n-1)

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  hs <- VU.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  print $ solve hs n k


{-# LANGUAGE BangPatterns #-}
import qualified Data.Vector.Unboxed as U
import qualified Data.ByteString.Char8 as C
import Data.List

main = do
    [n,k] <- unfoldr (C.readInt . C.dropWhile (==' ')) <$> C.getLine
    h <- U.unfoldrN n (C.readInt . C.dropWhile (==' ')) <$> C.getLine

    let dp = U.constructN n (\dp_ ->
            if U.null dp_ then 0
                else let !i = U.length dp_
                         !hi = h U.! i
                         f = U.slice (max 0 (i-k)) (min i k)
                         !refh = f h
                         !refd = f dp_
                    in U.minimum (
                        U.zipWith (\dc hc -> dc + abs(hi - hc)) refd refh
                        )
            )

    print $ U.last dp


import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Mutable as M
import qualified Data.ByteString.Char8 as C
import Data.List
import Control.Monad

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

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

main = do
    [n,k] <- r'
    h <- r n

    dp <- M.new n
    M.write dp 0 0

    step <- M.new k
    forM_ [1..n-1] (\i -> do
        forM_ [0..min k i - 1] (\j -> do
            rd <- M.read dp (i-j-1)
            M.write step j $ rd + abs( h U.! i  -  h U.! (i-j-1) )
            )
        minss <- mins $ M.slice 0 (min i k) step
        M.write dp i minss
        )

    res <- M.read dp (n-1)
    print res

mins v = minimum <$> toList v
toList v = mapM (M.read v) [0..M.length v-1]


f :: (Ord a, Num a) => Int -> ([a], [a]) -> a -> ([a], [a])
f k (hs, cs) h = (take k (h:hs), take k (c:cs))
  where
    c = minimum $ zipWith (+) cs $ fmap (abs . (h-)) hs

main = do
    let read' = fmap ((map read) . words) getLine
    [n, k] <- read'
    (h:hs) <- read'
    print $ (head . snd) $ foldl (f k) ([h], [0]) hs


import Data.Array (Array, listArray, (!))

dp f s e = result ! e where
  result = listArray (s,e) $ map nth [s..]
  nth i = f result i

minjumpcost :: Int -> Int -> Array Int Int -> Int
minjumpcost n k hs = dp f 1 n where
  f _ 1 = 0
  f t i =
    let costs = [(t!(i-j)) + abs ((hs!i)-(hs!(i-j))) | j <- [1..k], i-j>0]
    in
      minimum costs

main = do
  [n,k] <- map read . words <$> getLine
  hs <- listArray (1,n) . map read . words <$> getLine
  print $ minjumpcost n k hs


import qualified Data.ByteString.Char8 as B
import qualified Data.Vector.Unboxed as UV

a#b = abs$a-b

main = do
    [n,k] <- map read.words<$>getLine
    hr <- UV.unfoldr(B.readInt.B.dropWhile(<'!'))<$>B.getLine
    print $ f n k hr

inf = 10^18
f n k h = UV.last $ UV.foldl' proc (UV.singleton 0) $ UV.enumFromTo (1::Int) (n-1) where
    proc v0 dhi
        | dhi < k = UV.snoc v0 $ UV.minimum $ UV.zipWith m v0 h
        | otherwise = UV.tail $ UV.snoc v0 $ UV.minimum $ UV.zipWith m v0 $ UV.slice (dhi-k) k h
        where
            m sv sh = sv+sh# (h UV.! dhi)


import qualified Data.ByteString.Char8 as B
import qualified Data.Vector.Unboxed as UV

a#b = abs$a-b

main = do
    [n,k] <- map read.words<$>getLine
    hr <- UV.unfoldr(B.readInt.B.dropWhile(<'!'))<$>B.getLine
    print $ f n k hr

inf = 10^18
f n k h = UV.last $ UV.foldl' proc (UV.singleton 0) $ UV.enumFromTo (1::Int) (n-1) where
    proc v0 dhi
        | dhi < k = UV.snoc v0 $ UV.foldl' m inf $ UV.zip v0 h
        | otherwise = UV.tail $ UV.snoc v0 $ UV.foldl' m inf $ UV.zip v0 $ UV.slice (dhi-k) k h
        where
            m a (sv,sh) = min a (sv+sh# (h UV.! dhi))


jump :: Int -> [Int] -> Int
jump k [] = 0
jump k l = minimum $ js k k
  where
    js k 0 = []
    js k n | (length l) > k = ((jump k $ drop n l) + (abs $ (head l) - (head (drop n l)))) : (js k $ n-1)
         | otherwise = ((jump k $ drop n l) + (abs $ (head l) - (last l))) : (js k $ n-1)
main :: IO ()
main = do
  [n,k] <- map read.words <$> getLine
  l <- map read.words <$> getLine
  putStrLn $ show $ jump k l


{-# OPTIONS_GHC -O2 #-}
import qualified Control.Arrow         as Arrow
import qualified Control.Monad         as Monad
import qualified Data.Bits             as Bits
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.Char             as Char
import qualified Data.List             as List
import qualified Data.Vector.Unboxed   as VU
import qualified Data.Bool             as Bool

main :: IO ()
main = do
  (n, w) <- getAB
  xv <- VU.replicateM n getAB -- VU.Vector (重量, 価値)
  print $ solver xv (n, w)

data TreeF a
  = TreeF (Int, Int) (Maybe a)
instance Functor TreeF where
  fmap f (TreeF x Nothing)  = TreeF x Nothing
  fmap f (TreeF x (Just y)) = TreeF x (Just (f y))

solver :: VU.Vector (Int, Int) -> (Int, Int) -> Int
solver xv (n, w) = VU.foldr max (-1) $ dyna phi psi (n - 1) -- (n番目まで見たときの)価値表を作り、その要素の最大値を取り出す
  where
    psi 0 = TreeF (xv VU.! 0) Nothing -- 入力 VU.Vector (重量, 価値) に対して最初から順番に調べる
    psi i = TreeF (xv VU.! i) (Just (i - 1)) -- 一つ前までの結果を保持

{-
[0,.. 0, value,0,...0] -- weightの場所だけvalueが入ったサイズwのVU.Vector Int
入力一つごとにvalueをすべてに足す
[0,0,...]サイズweight分の0 <> 前回の結果にすべて入力されたvalueを足したVU.Vector Int
指定された重量以上の数値はzipWithによってカットされる
-}
    phi :: TreeF (CoFree TreeF (VU.Vector Int)) -> VU.Vector Int
    phi (TreeF (weight, value) Nothing)  = VU.generate (w + 1) (Bool.bool 0 value . (weight ==))
    phi (TreeF (weight, value) (Just t)) = VU.zipWith max prev vec -- wより重い部分をカットしつつ、余裕がある部分にいれたときの価値を加えている
      where
        prev = extract t
        vec  = VU.replicate weight 0 VU.++ VU.map (+value) prev

-- * 入出力
getI :: BSC8.ByteString -> Maybe (Int, BSC8.ByteString)
getI = fmap (Arrow.second BSC8.tail) . BSC8.readInt
getAB :: IO (Int, Int)
getAB = (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldrN 2 getI <$> BSC8.getLine
getABC :: IO (Int, Int, Int)
getABC = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) . VU.unfoldrN 3 getI <$> BSC8.getLine
getAN :: Int -> IO (VU.Vector Int)
getAN n = VU.unfoldrN n getI <$> BSC8.getLine

-- ! 射
newtype Fix f
  = InF { outF :: f (Fix f) }

pair :: (a -> b, a -> c) -> a -> (b, c)
pair (f, g) x = (f x, g x)

-- ! 下方射
cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata phi = phi . fmap (cata phi) . outF
-- ! 上方射
ana  :: Functor f => (b -> f b) -> (b -> Fix f)
ana psi = InF . fmap (ana psi) . psi
-- ! 双方射
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo phi psi = cata phi . ana psi

-- * 未来用データ(直和)
data Fx f a x
  = Fx { unFx :: Either a (f x) }
-- * 過去用データ（直積）
data Hx f a x
  = Hx { unHx :: (a, f x) }

-- * Fx f a は関手
instance Functor f => Functor (Fx f a) where
  fmap f (Fx (Left x))  = Fx (Left x)
  fmap f (Fx (Right x)) = Fx (Right (fmap f x))
-- * Hx f a は関手
instance Functor f => Functor (Hx f a) where
  fmap f (Hx (x, y)) = Hx (x, fmap f y)

-- * Fx f a の不動点
newtype Free f a
  = Free { unFree :: Fix (Fx f a) }
-- * Hx f a の不動点
newtype CoFree f a
  = CoFree { unCoFree :: Fix (Hx f a) }

-- * Free f は関手
instance Functor f => Functor (Free f) where
  fmap f = Free . cata (InF . phi) . unFree
    where
      phi (Fx (Left a))  = Fx (Left (f a))
      phi (Fx (Right b)) = Fx (Right b)
-- * CoFree f は関手
instance Functor f => Functor (CoFree f) where
  fmap f = CoFree . ana (psi . outF) . unCoFree
    where
      psi (Hx (a, x)) = Hx (f a, x)

-- * Free と CoFree の情報を出し入れする関数
extract :: Functor f => CoFree f t -> t
extract cf = case outF (unCoFree cf) of
  Hx (a, _) -> a

sub :: Functor f => CoFree f a -> f (CoFree f a)
sub cf = case outF (unCoFree cf) of
  Hx (_, b) -> fmap CoFree b

inject :: Functor f => a -> Free f a
inject = Free
    . InF
    . Fx
    . Left

-- ! 時空射
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' = CoFree
      . InF
      . fmap unCoFree
      . Hx
      . pair (phi, id)
    psi' = uncurry either (psi, id)
      . unFx
      . fmap Free
      . outF
      . unFree

-- ! dp射
dyna :: Functor f => (f (CoFree f b) -> b) -> (a -> f a) -> (a -> b)
dyna phi psi = chrono phi (fmap inject . psi)

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^5

1 \leq w_i \leq W

1 \leq v_i \leq 10^9

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

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

Sample Output 2

5000000000

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

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.


{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import qualified Data.Map.Lazy               as ML
import           Data.Char
import qualified Data.Array.IArray as A
import qualified Data.Array.Unboxed as UA
import Data.Bits
import Control.Monad.State.Strict

modN = 1000000007

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

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

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

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

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

pow :: Int -> Int -> Int -> Int
pow base 1 modNum = base `mod` modNum
pow base time modNum
    | odd time = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a * base `mod` modNum
    | otherwise = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a `mod` modNum

solve :: Int -> Int -> [(Int, Int)] -> Int
solve n w merchs = let
    valMap :: UA.Array Int (Int, Int)
    valMap = A.array (1, n) $ zip [1..] merchs
    getWV :: Int -> Int -> State (M.Map (Int, Int) Int) Int
    getWV 0 _ = pure 0
    getWV _ 0 = pure 0
    getWV w v = do
        memo <- get
        case M.lookup (w, v) memo of
            Just a -> pure a
            Nothing -> do
                let (wi, vi) = valMap A.! v
                nochoose <- getWV w (v - 1)
                ans <-  if wi > w then pure nochoose
                        else do
                            v2 <- getWV (w - wi) (v - 1)
                            pure $ max nochoose $ v2  + vi
                modify' $ M.insert (w, v) ans
                pure ans
    in evalState (getWV w n) M.empty

main = do
    (n, w) <- readTuple2
    merchs <- replicateM n readTuple2
    print $ solve n w merchs


{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import qualified Data.Map.Lazy               as ML
import           Data.Char
import qualified Data.Array.IArray as A
import Data.Bits

modN = 1000000007

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

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

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

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

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

pow :: Int -> Int -> Int -> Int
pow base 1 modNum = base `mod` modNum
pow base time modNum
    | odd time = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a * base `mod` modNum
    | otherwise = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a `mod` modNum

solve :: Int -> Int -> [(Int, Int)] -> Int
solve n w merchs = let
    valMap :: A.Array Int (Int, Int)
    valMap = A.array (1, n) $ zip [1..] merchs
    getWV :: Int -> Int -> Int
    getWV 0 _ = 0
    getWV _ 0 = 0
    getWV w v = let
        (wi, vi) = valMap A.! v
        nochoose = dp A.! (w, v - 1)
        in
            if wi > w then nochoose  else
                max nochoose $ dp A.! (w - wi, v - 1) + vi
    dp :: A.Array (Int, Int) Int
    dp = A.array ((0,0), (w,n)) [((i, v), getWV i v)| i <- [0..w], v <- [0..n]]
    in dp A.! (w, n)

main = do
    (n, w) <- readTuple2
    merchs <- replicateM n readTuple2
    print $ solve n w merchs


{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import qualified Data.Map.Lazy               as ML
import           Data.Char
import qualified Data.Array.IArray as A
import Data.Bits

modN = 1000000007

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

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

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

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

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

pow :: Int -> Int -> Int -> Int
pow base 1 modNum = base `mod` modNum
pow base time modNum
    | odd time = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a * base `mod` modNum
    | otherwise = let
        a = pow base (time `div` 2) modNum `mod` modNum
        in
        a * a `mod` modNum

solve :: Int -> Int -> [(Int, Int)] -> Int
solve n w merchs = let
    valMap = IM.fromList $ zip [1..] merchs
    getWV :: Int -> Int -> Int
    getWV 0 _ = 0
    getWV _ 0 = 0
    getWV w v = let
        (wi, vi) = valMap IM.! v
        nochoose = dp ML.! (w, v - 1)
        in
            if wi > w then nochoose  else
                max nochoose $ dp ML.! (w - wi, v - 1) + vi
    dp = ML.fromList [((i, v), getWV i v)| i <- [0..w], v <- [0..n]]
    in dp ML.! (w, n)

main = do
    (n, w) <- readTuple2
    merchs <- replicateM n readTuple2
    print $ solve n w merchs


import Control.Monad

solve n goods w = last $ foldl f initial goods where
  f acc (w, v) = zipWith max acc pick where
    pick = map (v+) $ replicate w (-v) ++ acc
  initial = replicate (w+1) 0

main = do
  [n,w] <- map read.words <$> getLine
  goods <- replicateM n $ (\[a,b]->(a,b)).map read.words <$> getLine
  print $ solve n goods w


import Data.Array
import Data.Array.ST
import Data.Array.MArray
import Control.Monad
import Control.Monad.ST

solve n goods w = runST $ do
  dp <- newArray ((0,0), (n,w)) (-1)
  f dp 0 w where
    gary = listArray (0, n-1) goods
    f :: STUArray s (Int,Int) Int -> Int -> Int -> ST s Int
    f dp i j = do
      mem <- readArray dp (i, j)
      if mem /= -1 then
        return mem
      else do
        res <- res
        writeArray dp (i, j) res
        return res
      where
        (wi, vi) = gary ! i
        res
          | i == n = return 0
          | j < wi = nxt
          | otherwise = liftM2 max nxt nx'
          where
            nxt = f dp (i+1) j
            nx' = (+vi) <$> f dp (i+1) (j-wi)

main = do
  [n,w] <- map read.words <$> getLine
  goods <- replicateM n $ (\[a,b]->(a,b)).map read.words <$> getLine
  print $ solve n goods w


{-# LANGUAGE BangPatterns #-}

import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import qualified Data.ByteString.Char8 as BS
import           Data.Char
import           Data.List

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

getAsIntLine :: Int -> IO [[Int]]
getAsIntLine n = replicateM n getAsInt

getAsIntArray2D :: Int -> Int -> IO (UArray (Int,Int) Int)
getAsIntArray2D n m = U.listArray ((1,1),(n,m)) . concat <$> getAsIntLine n

main :: IO ()
main = main1

main1 :: IO ()
main1 = do
  [!n,!w] <- getAsInt
  !wvs <- getAsIntArray2D n 2
  let !solve = solve1'
      !result = solve wvs n w
  print $ maximum $ map (\x -> result U.! (n,x)) [0..w]

main2 :: IO ()
main2 = do
  [n,w] <- getAsInt
  wvs <- map (\[x,y] -> (x, y)) <$> getAsIntLine n
  let solve = solve2'
      result = solve w wvs
  print $ maximum $ map (\x -> result U.! x) [0..w]

solve1 :: UArray (Int,Int) Int -> Int -> Int -> UArray (Int,Int) Int
solve1 wvs n' w' = runSTUArray $ do
  dp <- newArray ((0,0),(n',w')) 0
  forM_ [(n_,w_) | n_ <- [1..n'], w_ <- [0..w']] $ \(n,w) -> do
    let wtmp = wvs U.! (n,1)
        vtmp = wvs U.! (n,2)
    if w - wtmp < 0
      then readArray dp (n-1,w) >>= writeArray dp (n,w)
      else do
        a <- readArray dp (n-1,w)
        b <- readArray dp (n-1,w-wtmp)
        writeArray dp (n,w) $ max a (b+vtmp)
  return dp

solve1' :: UArray (Int,Int) Int -> Int -> Int -> UArray (Int,Int) Int
solve1' !wvs !n' !w' = runSTUArray $ do
  !dp <- newArray ((0,0),(n',w')) 0
  forM_ [(n_,w_) | !n_ <- [1..n'], !w_ <- [0..w']] $ \(!n,!w) -> do
    let !wtmp = wvs U.! (n,1)
        !vtmp = wvs U.! (n,2)
    if w - wtmp < 0
      then readArray dp (n-1,w) >>= \ !a -> writeArray dp (n,w) a
      else do
        !a <- readArray dp (n-1,w)
        !b <- readArray dp (n-1,w-wtmp)
        writeArray dp (n,w) $ max a (b+vtmp)
  return dp

solve2 :: Int -> [(Int,Int)] -> UArray Int Int
solve2 w' [] = U.listArray (0,w') $ repeat 0
solve2 w' ((wtmp,vtmp):xs) = let a = solve2 w' xs
                                 f w = if w - wtmp >= 0
                                       then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                       else a U.! w
                             in U.array (0,w') [(w, f w) | w <- [0..w']]

solve2' :: Int -> [(Int,Int)] -> UArray Int Int
solve2' !w' [] = U.listArray (0,w') $ repeat 0
solve2' !w' ((!wtmp,!vtmp):(!xs)) = let !a = solve2' w' xs
                                        f !w = if w - wtmp >= 0
                                               then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                               else a U.! w
                                    in U.array (0,w') [(w, f w) | !w <- [0..w']]

solve3 :: Int -> [(Int,Int)] -> UArray Int Int
solve3 w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (wtmp,vtmp) a = let g w = if w - wtmp >= 0
                                    then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                    else a U.! w
                          in U.array (0,w') [(w, g w) | w <- [0..w']]

solve3' :: Int -> [(Int,Int)] -> UArray Int Int
solve3' !w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (!wtmp,!vtmp) !a = let g !w = if w - wtmp >= 0
                                        then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                        else a U.! w
                             in U.array (0,w') [(w, g w) | !w <- [0..w']]


{-# LANGUAGE BangPatterns #-}

import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import qualified Data.ByteString.Char8 as BS
import           Data.Char
import           Data.List

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

getAsIntLine :: Int -> IO [[Int]]
getAsIntLine n = replicateM n getAsInt

getAsIntArray2D :: Int -> Int -> IO (UArray (Int,Int) Int)
getAsIntArray2D n m = U.listArray ((1,1),(n,m)) . concat <$> getAsIntLine n

main :: IO ()
main = main2

main1 :: IO ()
main1 = do
  [n,w] <- getAsInt
  wvs <- getAsIntArray2D n 2
  let result = solve1 wvs n w
  print $ maximum $ map (\x -> result U.! (n,x)) [0..w]

main2 :: IO ()
main2 = do
  [n,w] <- getAsInt
  wvs <- map (\[x,y] -> (x, y)) <$> getAsIntLine n
  let solve = solve2'
      result = solve w wvs
  print $ maximum $ map (\x -> result U.! x) [0..w]

solve1 :: UArray (Int,Int) Int -> Int -> Int -> UArray (Int,Int) Int
solve1 wvs n' w' = runSTUArray $ do
  dp <- newArray ((0,0),(n',w')) 0
  forM_ [(n_,w_) | n_ <- [1..n'], w_ <- [0..w']] $ \(n,w) -> do
    let wtmp = wvs U.! (n,1)
        vtmp = wvs U.! (n,2)
    if w - wtmp < 0
      then readArray dp (n-1,w) >>= writeArray dp (n,w)
      else do
        a <- readArray dp (n-1,w)
        b <- readArray dp (n-1,w-wtmp)
        writeArray dp (n,w) $ max a (b+vtmp)
  return dp

solve2 :: Int -> [(Int,Int)] -> UArray Int Int
solve2 w' [] = U.listArray (0,w') $ repeat 0
solve2 w' ((wtmp,vtmp):xs) = let a = solve2 w' xs
                                 f w = if w - wtmp >= 0
                                       then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                       else a U.! w
                             in U.array (0,w') [(w, f w) | w <- [0..w']]

solve2' :: Int -> [(Int,Int)] -> UArray Int Int
solve2' !w' [] = U.listArray (0,w') $ repeat 0
solve2' !w' ((!wtmp,!vtmp):(!xs)) = let !a = solve2 w' xs
                                        f !w = if w - wtmp >= 0
                                               then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                               else a U.! w
                                    in U.array (0,w') [(w, f w) | !w <- [0..w']]

solve3 :: Int -> [(Int,Int)] -> UArray Int Int
solve3 w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (wtmp,vtmp) a = let g w = if w - wtmp >= 0
                                    then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                    else a U.! w
                          in U.array (0,w') [(w, g w) | w <- [0..w']]

solve3' :: Int -> [(Int,Int)] -> UArray Int Int
solve3' !w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (!wtmp,!vtmp) !a = let g !w = if w - wtmp >= 0
                                        then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                        else a U.! w
                          in U.array (0,w') [(w, g w) | !w <- [0..w']]


{-# LANGUAGE BangPatterns #-}

import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import qualified Data.ByteString.Char8 as BS
import           Data.Char
import           Data.List

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

getAsIntLine :: Int -> IO [[Int]]
getAsIntLine n = replicateM n getAsInt

getAsIntArray2D :: Int -> Int -> IO (UArray (Int,Int) Int)
getAsIntArray2D n m = U.listArray ((1,1),(n,m)) . concat <$> getAsIntLine n

main :: IO ()
main = main2

main1 :: IO ()
main1 = do
  [n,w] <- getAsInt
  wvs <- getAsIntArray2D n 2
  let result = solve1 wvs n w
  print $ maximum $ map (\x -> result U.! (n,x)) [0..w]

main2 :: IO ()
main2 = do
  [n,w] <- getAsInt
  wvs <- map (\[x,y] -> (x, y)) <$> getAsIntLine n
  let solve = solve3
      result = solve w wvs
  print $ maximum $ map (\x -> result U.! x) [0..w]

solve1 :: UArray (Int,Int) Int -> Int -> Int -> UArray (Int,Int) Int
solve1 wvs n' w' = runSTUArray $ do
  dp <- newArray ((0,0),(n',w')) 0
  forM_ [(n_,w_) | n_ <- [1..n'], w_ <- [0..w']] $ \(n,w) -> do
    let wtmp = wvs U.! (n,1)
        vtmp = wvs U.! (n,2)
    if w - wtmp < 0
      then readArray dp (n-1,w) >>= writeArray dp (n,w)
      else do
        a <- readArray dp (n-1,w)
        b <- readArray dp (n-1,w-wtmp)
        writeArray dp (n,w) $ max a (b+vtmp)
  return dp

solve2 :: Int -> [(Int,Int)] -> UArray Int Int
solve2 w' [] = U.listArray (0,w') $ repeat 0
solve2 w' ((wtmp,vtmp):xs) = let a = solve2 w' xs
                                 f w = if w - wtmp >= 0
                                       then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                       else a U.! w
                             in U.array (0,w') [(w, f w) | w <- [0..w']]

solve3 :: Int -> [(Int,Int)] -> UArray Int Int
solve3 w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (wtmp,vtmp) a = let g w = if w - wtmp >= 0
                                    then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                    else a U.! w
                          in U.array (0,w') [(w, g w) | w <- [0..w']]

solve3' :: Int -> [(Int,Int)] -> UArray Int Int
solve3' !w' = foldr f (U.listArray (0,w') $ repeat 0)
  where f (!wtmp,!vtmp) !a = let g !w = if w - wtmp >= 0
                                        then max (a U.! w) (a U.! (w - wtmp) + vtmp)
                                        else a U.! w
                          in U.array (0,w') [(w, g w) | !w <- [0..w']]


{-# LANGUAGE BangPatterns #-}
import Data.Char (isSpace)
import Data.Int (Int64)
import Data.List (unfoldr)
import qualified Data.Vector.Unboxed as U
import qualified Data.ByteString.Char8 as BS
import Control.Monad (replicateM)

main = do
  [n,maxW] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  items <- replicateM n $ do
    [w,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
    return (w, fromIntegral v :: Int64)
  print $ solve maxW items U.! maxW

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


import Data.Char (isSpace)
import Data.Int (Int64)
import Data.List (unfoldr)
import qualified Data.Vector.Unboxed as U
import qualified Data.ByteString.Char8 as BS
import Control.Monad (replicateM)

main = do
  [n,maxW] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  items <- replicateM n $ do
    [w,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
    return (w, fromIntegral v :: Int64)
  print $ solve maxW items U.! maxW

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


import Data.Array((!), listArray)
main = interact $ show.helper.(map read).words
helper (n:wei:xs) = maximum $ rec ws vs
                  where (ws, vs) = cvr xs
                        rec [] [] = listArray (1, wei) $ replicate wei 0
                        rec (w:ww) (v:vv) = fff w v $ rec ww vv
                        fff w v dp = listArray (1, wei) $
                                     [max (f (i-w) v dp) (dp!i)| i<-[1..wei]]
                        f i v dp
                             | i == 0 = v
                             | i < 0  = 0
                             | otherwise =v + dp!i

cvr (a:b:[]) = ([a], [b])
cvr (a:b:ss) = (a:x, b:y)
               where (x, y) = cvr ss


{-# 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

solve :: Int -> Int -> [(Int,Int)] -> Int
solve bN bW wvs = vecFin VU.! bW
  where
  vecFin = foldl' op (VU.replicate (bW+1) 0) wvs
  op vec (w,v) =
    VU.zipWith max vec (VU.replicate w 0 VU.++ VU.map (+ v) vec)

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_bW]:remLines1 = remLines0
      bN = readBInt bs_bN
      bW = readBInt bs_bW
      wvs = map (\[x1,x2] -> (readBInt x1,readBInt x2)) remLines1
  in solve bN bW wvs

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

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


import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector           as V
import qualified Data.Vector.Unboxed   as VU

main :: IO ()
main = do
  s <- BS.getLine
  t <- BS.getLine
  let solve = solve2
  putStrLn $ solve s t

table2 :: ByteString -> ByteString -> V.Vector (VU.Vector Int)
table2 xs ys = V.scanl step (VU.replicate (m+1) 0) xs'
  where n = BS.length xs
        m = BS.length ys
        xs' = V.generate n $ BS.index xs
        ys' = VU.generate m $ BS.index ys
        -- <(i-1,j)> -> i -> <(i,j)>
        step :: VU.Vector Int -> Char -> VU.Vector Int
        step v x = VU.scanl innerStep 0 $ VU.zip3 v (VU.tail v) ys'
          where
            -- (i,j-1) -> ((i-1,j-1),(i-1,j),j) -> (i,j)
            -- 第二引数はvから生成されているので、i-1 (iではなく)
            innerStep :: Int -> (Int,Int,Char) -> Int
            innerStep a (b,c,y) | x == y = b + 1
                                | otherwise = max a c

solve2 :: ByteString -> ByteString -> String
solve2 s t = go (BS.length s) (BS.length t) ""
  where tbl = table2 s t
        go 0 _ ss = ss
        go _ 0 ss = ss
        go i j ss
          | tbl V.! i VU.! j == tbl V.! (i-1) VU.! j = go (i-1) j ss
          | tbl V.! i VU.! j == tbl V.! i VU.! (j-1) = go i (j-1) ss
          | otherwise                                = go (i-1) (j-1) ((s `BS.index` (i-1)):ss)

Score : 100 points

Problem Statement

You are given strings s and t.
Find one longest string that is a subsequence of both s and t.

Notes

A subsequence of a string x is the string obtained by removing zero or more characters from x and concatenating the remaining characters without changing the order.

Constraints

s and t are strings consisting of lowercase English letters.

1 \leq |s|, |t| \leq 3000

Input

Input is given from Standard Input in the following format:

s
t

Output

Print one longest string that is a subsequence of both s and t.
If there are multiple such strings, any of them will be accepted.

Sample Input 1

axyb
abyxb

Sample Output 1

axb

The answer is axb or ayb; either will be accepted.

Sample Input 2

aa
xayaz

Sample Output 2

aa

Sample Input 3

a
z

Sample Output 3

The answer is (an empty string).

Sample Input 4

abracadabra
avadakedavra

Sample Output 4

aaadara


import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import qualified Data.ByteString.Char8 as BS
import           Data.List

getAsCharArray1DWithLength :: IO (Int, UArray Int Char)
getAsCharArray1DWithLength = BS.getLine >>= \cs ->
  let n = BS.length cs
      ary = (U.listArray (1,n) $ unfoldr BS.uncons cs) :: UArray Int Char
  in return (n, ary)

main :: IO ()
main = do
  (n,sa) <- getAsCharArray1DWithLength
  (m,ta) <- getAsCharArray1DWithLength
  let result = solve (n,sa) (m,ta)
  putStrLn $ restore sa result n m

solve :: (Int, UArray Int Char) -> (Int, UArray Int Char) -> UArray (Int,Int) Int
solve (n',sa) (m',ta) = runSTUArray $ do
  dp <- newArray ((0,0),(n',m')) 0
  forM_ [(n_,m_) | n_ <- [1..n'], m_ <- [1..m']] $ \(n,m) -> do
    a <- readArray dp (n-1,m-1)
    b <- readArray dp (n,m-1)
    c <- readArray dp (n-1,m)
    if sa U.! n == ta U.! m
      then writeArray dp (n,m) $ maximum [a+1,b,c]
      else writeArray dp (n,m) $ maximum [b,c]
  return dp

restore :: UArray Int Char -> UArray (Int,Int) Int -> Int -> Int -> String
restore st ary n m = go n m ""
  where go 0 _ ss = ss
        go _ 0 ss = ss
        go i j ss
          | ary U.! (i,j) == ary U.! (i-1,j) = go (i-1) j ss
          | ary U.! (i,j) == ary U.! (i,j-1) = go i (j-1) ss
          | otherwise                        = go (i-1) (j-1) ((st U.! i):ss)


import           Control.Monad
import           Data.Array.ST
import           Data.Array.Unboxed    (UArray)
import qualified Data.Array.Unboxed    as U
import qualified Data.ByteString.Char8 as BS
import           Data.List

getAsCharArray1DWithLength :: IO (Int, UArray Int Char)
getAsCharArray1DWithLength = BS.getLine >>= \cs ->
  let n = BS.length cs
      ary = (U.listArray (1,n) $ unfoldr BS.uncons cs) :: UArray Int Char
  in return (n, ary)

main :: IO ()
main = do
  nsa <- getAsCharArray1DWithLength
  mta <- getAsCharArray1DWithLength
  print $ solve1 nsa mta U.! (fst nsa, fst mta)

solve1 :: (Int, UArray Int Char) -> (Int, UArray Int Char) -> UArray (Int,Int) Int
solve1 (n',sa) (m',ta) = runSTUArray $ do
  dp <- newArray ((0,0),(n',m')) 0
  forM_ [(n_,m_) | n_ <- [1..n'], m_ <- [1..m']] $ \(n,m) -> do
    a <- readArray dp (n-1,m-1)
    b <- readArray dp (n,m-1)
    c <- readArray dp (n-1,m)
    d <- readArray dp (n,m)
    if sa U.! n == ta U.! m
      then writeArray dp (n,m) $ maximum [a+1,b,c,d]
      else writeArray dp (n,m) $ maximum [b,c,d]
  return dp


{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.ByteString.Char8 as BS

makeTable :: BS.ByteString -> BS.ByteString -> UArray (Int,Int) Int
makeTable xs ys =
  runSTUArray $ do
    dp <- newArray ((0,0),(BS.length xs, BS.length ys)) 0
    forM_ [0..BS.length xs -1] $ \i ->
      forM_ [0..BS.length ys - 1] $ \j ->
        if BS.index xs i == BS.index ys j
           then do
             rd <- readArray dp (i,j)
             writeArray dp (i+1,j+1) $! rd+1
           else do
             rd1 <- readArray dp (i+1,j)
             rd2 <- readArray dp (i,j+1)
             writeArray dp (i+1,j+1) $! max rd1 rd2
    return dp

construct :: UArray (Int,Int) Int -> BS.ByteString -> BS.ByteString -> (Int,Int) -> BS.ByteString -> BS.ByteString
construct dp xs ys (n,m) bs
  | n == 0 || m == 0 = bs
  | BS.index xs (n-1) == BS.index ys (m-1) = construct dp xs ys (n-1,m-1) (BS.cons (BS.index xs (n-1)) bs)
  | otherwise =
    let
      a = dp ! (n-1,m)
      b = dp ! (n,m-1)
    in
      if a >= b then construct dp xs ys (n-1,m) bs
                else construct dp xs ys (n,m-1) bs
main = do
  xs <- BS.getLine
  ys <- BS.getLine
  let n = BS.length xs
  let m = BS.length ys
  let dp = makeTable xs ys
  putStrLn $ BS.unpack $ construct dp xs ys (n,m) BS.empty


{-# LANGUAGE ViewPatterns #-}
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

type DP = M.Map (Int,Int) Int

solve :: BS.ByteString -> BS.ByteString -> (Int,Int) -> DP -> DP
solve _ (BS.uncons -> Nothing) _ dp = dp
solve ss (BS.uncons -> Just (t, ts)) point dp =
  loop ss t point dp
  where
    loop :: BS.ByteString -> Char -> (Int,Int) -> DP -> DP
    loop (BS.uncons -> Nothing) _ (y,x) dp = solve ss ts (y+1,1) dp
    loop (BS.uncons -> Just (a, as)) b (y,x) dp
      | a == b =
        case M.lookup (y-1,x-1) dp of
          Just v -> loop as b (y,x+1) $ M.insert (y,x) (v+1) dp
          Nothing -> loop as b (y,x+1) $ M.insert (y,x) 1 dp
      | otherwise =
        let f = findFromPair (y-1,x) (y,x-1) dp in loop as b (y,x+1) $ M.insert (y,x) f dp

    findFromPair :: (Int,Int) -> (Int,Int) -> DP -> Int
    findFromPair p q dp =
      case [(M.lookup p dp), (M.lookup q dp)] of
        [Nothing, Nothing] -> 0
        [Just v, Nothing] -> v
        [Nothing, Just w] -> w
        [Just v, Just w] -> if v >= w then v else w

main = do
  s <- BS.getLine
  t <- BS.getLine
  let dp = solve s t (1,1) M.empty
  print $ M.deleteFindMax dp


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

type DP = M.Map (Int,Int) String

solve :: String -> String -> (Int,Int) -> DP -> DP
solve _ [] _ dp = dp
solve ss (t:ts) point dp =
  loop ss t point dp
  where
    loop :: String -> Char -> (Int,Int) -> DP -> DP
    loop [] _ (y,x) dp = solve ss ts (y+1,1) dp
    loop (a:as) b (y,x) dp
      | a == b =
        case M.lookup (y-1,x-1) dp of
          Just v -> loop as b (y,x+1) $ M.insert (y,x) (a:v) dp
          Nothing -> loop as b (y,x+1) $ M.insert (y,x) [a] dp
      | otherwise =
        let f = findFromPair (y-1,x) (y,x-1) dp in loop as b (y,x+1) $ M.insert (y,x) f dp

    findFromPair :: (Int,Int) -> (Int,Int) -> DP -> String
    findFromPair p q dp =
      case [(M.lookup p dp), (M.lookup q dp)] of
        [Nothing, Nothing] -> undefined
        [Just v, Nothing] -> v
        [Nothing, Just w] -> w
        [Just v, Just w] -> if length v >= length w then v else w
main = do
  s <- getLine
  t <- getLine
  let dp = solve s t (1,1) M.empty
  putStrLn $ reverse $ snd $ fst $ M.deleteFindMax dp


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

import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (unfoldr, foldl')
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

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

---------------------------------------------------------
data SkewHeap a = Empty
                | SkewNode a (SkewHeap a) (SkewHeap a)
                deriving (Show)

(+++) :: Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
heap1@(SkewNode x1 l1 r1) +++ heap2@(SkewNode x2 l2 r2)
  | x1 >= x2   = SkewNode x1 (heap2 +++ r1) l1
  | otherwise  = SkewNode x2 (heap1 +++ r2) l2
Empty +++ heap = heap
heap +++ Empty = heap

node :: a -> SkewHeap a
node x = SkewNode x Empty Empty

extractMax Empty = Nothing
extractMax (SkewNode x l r ) = Just (x , l +++ r )

toSkewHeap :: Ord a => [a] -> SkewHeap a
toSkewHeap = foldl' (+++) Empty . map node

fromSkewHeap :: SkewHeap a -> [a]
fromSkewHeap = foldSkewHeap [] (\a l r -> a:(l ++ r))

foldSkewHeap :: b -> (a -> b -> b -> b) -> SkewHeap a -> b
foldSkewHeap c f = u
  where
    u Empty = c
    u (SkewNode a l r) = f a (u l) (u r)

paraSkewHeap :: b -> (a -> (SkewHeap a, b) -> (SkewHeap a, b) -> b) -> SkewHeap a -> b
paraSkewHeap c g = u
  where
    u Empty = c
    u (SkewNode a l r) = g a (l, u l) (r, u r)

takeWhileSkewHeap :: (a -> Bool) -> SkewHeap a -> SkewHeap a
takeWhileSkewHeap p = foldSkewHeap c f
  where
    c = Empty
    f a l r | p a = SkewNode a l r
            | otherwise = Empty

dropWhileSkewHeap :: Ord a => (a -> Bool) -> SkewHeap a -> SkewHeap a
dropWhileSkewHeap p = paraSkewHeap c g
  where
    c = Empty
    g a (l, l') (r, r') | p a = l' +++ r'
                        | otherwise = SkewNode a l r

sumSkewHeap :: SkewHeap Int -> Integer
sumSkewHeap = foldSkewHeap 0 (\a l r -> fromIntegral a + l + r)

---------------------------------------------------------
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) }

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))

---------------------------------------------------------
fst3 (x,_,_) = x
snd3 (_,y,_) = y
thd3 (_,_,z) = z

main :: IO ()
main = do
  !s <- C.cons '\NUL' <$> C.getLine
  !t <- C.cons '\NUL' <$> C.getLine
  let solved = solve s t
  putStrLn $ regain solved t

data NonEmptyListF a b = NonEmptyListF a (Maybe b) deriving (Show, Functor)

{-# INLINE (!!!) #-}
(!!!) :: UM.Unbox a => V.Vector (U.Vector a) -> (Int, Int) -> a
v !!! (i, j) = (v V.! i) U.! j

regain :: V.Vector (U.Vector (Char, Int)) -> C.ByteString -> String
regain solved rs = go [] (rlen-1, clen-1)
  where
    (!rlen, !clen) = (V.length solved, U.length $ V.head solved)
    !mat = V.reverse solved

    go :: String -> (Int, Int) -> String
    go res (!i, !j) | i <= 0 || j <= 0 = res
                    | n == snd (mat !!! (i,j-1)) = go res (i, j-1)
                    | n == snd (mat !!! (i-1,j)) = go res (i-1, j)
                    | otherwise = go (c':res) (i-1, j-1)
      where
        !c = rs `C.index` i
        (!c', !n) = mat !!! (i, j)

solve :: C.ByteString -> C.ByteString -> V.Vector (U.Vector (Char, Int))
solve !cs !rs = dyna phi psi (rlen-1)
  where
    (!clen, !rlen) = (C.length cs, C.length rs)

    psi 0 = NonEmptyListF (rs `C.index` 0) Nothing
    psi i = NonEmptyListF (rs `C.index` i) (Just (i-1))

    phi :: NonEmptyListF Char (Cofree (NonEmptyListF Char) (V.Vector (U.Vector (Char, Int)))) -> V.Vector (U.Vector (Char, Int))
    phi (NonEmptyListF _ Nothing) = V.singleton $ U.generate clen $ \i -> (cs `C.index` i, 0)
    phi (NonEmptyListF !c (Just t)) = vec `V.cons` prevs
      where
        prevs = extract t
        prev = V.head prevs
        vec = U.cons ('\NUL', 0) $! U.unfoldr p (0, U.zip prev (U.tail prev))
          where
            p (!l, !xs) | U.null xs = Nothing
                        | otherwise =
                            let ((_, !lu), (!c', !u)) = U.head xs
                                !xs' = U.tail xs
                                !l' = bool (max l u) (lu+1) (c==c')
                            in Just ((c', l'), (l', xs'))


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

import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (unfoldr)
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

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 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)) }
{-# INLINE extract #-}
extract :: Cofree f t -> t
extract = fst . unCf
{-# INLINE sub #-}
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)) }
{-# INLINE inject #-}
inject :: a -> Free f a
inject = Fr . Left

-- catamorphism
{-# INLINE cata #-}
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
{-# INLINE ana #-}
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
{-# INLINE hylo #-}
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
{-# INLINE meta #-}
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
{-# INLINE para #-}
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
{-# INLINE apo #-}
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
{-# INLINE histo #-}
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata (Cf . pair (phi, id))
-- futumorphism
{-# INLINE futu #-}
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana (uncurry either (psi, id) . unFr) . inject
-- chronomorphism
{-# INLINE chrono #-}
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' = Cf . pair (phi, id)
    psi' = uncurry either (psi, id) . unFr
-- cochronomorphism
{-# INLINE cochrono #-}
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
{-# INLINE zygo #-}
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
{-# INLINE cozygo #-}
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
{-# INLINE dyna #-}
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
{-# INLINE codyna #-}
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
{-# INLINE mutu #-}
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
{-# INLINE comutu #-}
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))

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

main :: IO ()
main = do
  !s <- C.cons '\NUL' <$> C.getLine
  !t <- C.cons '\NUL' <$> C.getLine
  let solved = solve s t
  putStrLn $ regain solved t

data NonEmptyListF a = NonEmptyListF Char (Maybe a) deriving (Show, Functor)

regain :: V.Vector (U.Vector (Char, Int)) -> C.ByteString -> String
regain solved rs = go [] (rlen-1, clen-1)
  where
    (rlen, clen) = (V.length solved, U.length $ V.head solved)
    !mat = V.reverse solved

    go res (i, j) | i <= 0 || j <= 0 = res
                  | n == l = go res (i, j-1)
                  | n == u = go res (i-1, j)
                  | otherwise = go (c':res) (i-1, j-1)
      where
        c = rs `C.index` i
        (c', n) = (mat V.! i) U.! j
        (_, l) = (mat V.! i) U.! (j-1)
        (_, u) = (mat V.! (i-1)) U.! j

solve :: C.ByteString -> C.ByteString -> V.Vector (U.Vector (Char, Int))
solve !cs !rs = dyna phi psi (rlen-1)
  where
    (!clen, !rlen) = (C.length cs, C.length rs)

    psi 0 = NonEmptyListF (rs `C.index` 0) Nothing
    psi i = NonEmptyListF (rs `C.index` i) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF (V.Vector (U.Vector (Char, Int)))) -> V.Vector (U.Vector (Char, Int))
    phi (NonEmptyListF _ Nothing) = V.singleton $ U.generate clen $ \i -> (cs `C.index` i, 0)
    phi (NonEmptyListF !c (Just t)) = vec `V.cons` prevs
      where
        prevs = extract t
        prev = V.head prevs
        vec = U.cons ('\NUL', 0) $! U.unfoldr p (0, U.zip prev (U.tail prev))
          where
            p (!l, !xs) | U.null xs = Nothing
                        | otherwise =
                            let (((_, !lu), (!c', !u)), !xs') = (U.head xs, U.tail xs)
                                !l' = bool (max l u) (lu+1) (c==c')
                            in Just ((c', l'), (l', xs'))


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

import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (unfoldr)
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

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

----------------------------
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) }

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))

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

main :: IO ()
main = do
  !s <- C.cons '\NUL' <$> C.getLine
  !t <- C.cons '\NUL' <$> C.getLine
  let solved = solve s t
  putStrLn $ regain solved t

data NonEmptyListF a = NonEmptyListF Char (Maybe a) deriving (Show, Functor)

regain :: V.Vector (U.Vector (Char, Int)) -> C.ByteString -> String
regain solved rs = go [] (rlen-1, clen-1)
  where
    (rlen, clen) = (V.length solved, U.length $ V.head solved)
    !mat = V.reverse solved

    go res (i, j) | i <= 0 || j <= 0 = res
                  | n == l = go res (i, j-1)
                  | n == u = go res (i-1, j)
                  | otherwise = go (c':res) (i-1, j-1)
      where
        c = rs `C.index` i
        (c', n) = (mat V.! i) U.! j
        (_, l) = (mat V.! i) U.! (j-1)
        (_, u) = (mat V.! (i-1)) U.! j

solve :: C.ByteString -> C.ByteString -> V.Vector (U.Vector (Char, Int))
solve !cs !rs = dyna phi psi (rlen-1)
  where
    (!clen, !rlen) = (C.length cs, C.length rs)

    psi 0 = NonEmptyListF (rs `C.index` 0) Nothing
    psi i = NonEmptyListF (rs `C.index` i) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF (V.Vector (U.Vector (Char, Int)))) -> V.Vector (U.Vector (Char, Int))
    phi (NonEmptyListF _ Nothing) = V.singleton $ U.generate clen $ \i -> (cs `C.index` i, 0)
    phi (NonEmptyListF !c (Just t)) = vec `V.cons` prevs
      where
        prevs = extract t
        prev = V.head prevs
        vec = U.cons ('\NUL', 0) $! U.unfoldr p (0, U.zip prev (U.tail prev))
          where
            p (!l, !xs) | U.null xs = Nothing
                        | otherwise =
                            let (((_, !lu), (!c', !u)), !xs') = (U.head xs, U.tail xs)
                                !l' = bool (max l u) (lu+1) (c==c')
                            in Just ((c', l'), (l', xs'))


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

import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (unfoldr)
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

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

----------------------------
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) }

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))

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

main :: IO ()
main = do
  !s <- C.cons '\NUL' <$> C.getLine
  !t <- C.cons '\NUL' <$> C.getLine
  let solved = solve s t
  putStrLn $ regain solved t

data NonEmptyListF a = NonEmptyListF Char (Maybe a) deriving (Show, Functor)

regain :: V.Vector (U.Vector (Char, Int)) -> C.ByteString -> String
regain solved rs = go [] (rlen-1, clen-1)
  where
    rlen = V.length solved
    clen = U.length $ V.head solved
    !mat = V.reverse solved

    go res (i, j) | i <= 0 || j <= 0 = res
                  | n == l = go res (i, j-1)
                  | n == u = go res (i-1, j)
                  | otherwise = go (c':res) (i-1, j-1)
      where
        c = rs `C.index` i
        (c', n) = (mat V.! i) U.! j
        (_, l) = (mat V.! i) U.! (j-1)
        (_, u) = (mat V.! (i-1)) U.! j

solve :: C.ByteString -> C.ByteString -> V.Vector (U.Vector (Char, Int))
solve !cs !rs = dyna phi psi (rlen-1)
  where
    !clen = C.length cs
    !rlen = C.length rs

    psi 0 = NonEmptyListF (rs `C.index` 0) Nothing
    psi i = NonEmptyListF (rs `C.index` i) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF (V.Vector (U.Vector (Char, Int)))) -> V.Vector (U.Vector (Char, Int))
    phi (NonEmptyListF _ Nothing) = V.singleton $ U.generate clen $ \i -> (cs `C.index` i, 0)
    phi (NonEmptyListF !c (Just t)) = vec `V.cons` prevs
      where
        prevs = extract t
        prev = V.head prevs
        vec = U.cons ('\NUL', 0) $! U.unfoldr p (0, U.zip prev (U.tail prev))
          where
            p (!l, !xs) | U.null xs = Nothing
                        | otherwise =
                            let ((_, !lu), (!c', !u)) = U.head xs
                                !xs' = U.tail xs
                                !l' = bool (max l u) (lu+1) (c==c')
                            in Just ((c', l'), (l', xs'))


{-# LANGUAGE BangPatterns #-}
import Data.Word
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import Data.Array

-- Input: s t
-- Output: arr
--   (arr ! i) ! j == length of lcs of (drop i s, drop j t)
lcsTable :: BS.ByteString -> BS.ByteString -> Array (Int, Int) Int
lcsTable s t = let arr = array ((0,0), (n,m)) $
                     [ ((i,0),0) | i <- [0..n] ] ++
                     [ ((0,j),0) | j <- [1..m] ] ++
                     [ ((i+1,j+1),a) | (i,x) <- zip [0..n-1] (BS.unpack s)
                                     , (j,y) <- zip [0..m-1] (BS.unpack t)
                                     , let a | x == y = 1 + arr!(i,j)
                                             | otherwise = max (arr!(i+1,j)) (arr!(i,j+1))
                                     ]
               in arr
  where !n = BS.length s
        !m = BS.length t

solve :: BS.ByteString -> BS.ByteString -> String
solve !s !t = let !table = lcsTable s t
                  !n = BS.length s
                  !m = BS.length t
                  recon !i !j acc | i == 0 || j == 0 = acc
                                  | x == y = recon (i-1) (j-1) (x : acc)
                                  | table!(i-1,j) >= table!(i,j-1) = recon (i-1) j acc
                                  | otherwise = recon i (j-1) acc
                    where x = BS.index s (i-1)
                          y = BS.index t (j-1)
              in recon n m []

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  putStrLn (solve s t)


{-# LANGUAGE BangPatterns #-}
import Data.Word
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U

-- Input: s t
-- Output: arr
--   (arr ! i) ! j == length of lcs of (drop i s, drop j t)
lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (U.Vector Word16)
lcsTable s t = V.scanr' (\ !x !v ->
                           -- for some i (0 <= i < m),
                           --   x = BS.index s i :: Char
                           --   v = arr ! (i+1) :: U.Vector Word16
                           U.scanr (\(!y,!w,!u) !l ->
                                      -- for some j (0 <= j < n)
                                      --   y = BS.index t j :: Char
                                      --   w = (arr ! (i+1)) ! j :: Word16
                                      --   u = (arr ! (i+1)) ! (j+1) :: Word16
                                      --   l = (arr ! i) ! (j+1) :: Word16
                                      if x == y
                                      then u + 1
                                      else max w l
                                   ) 0 (U.zip3 t' (U.init v) (U.tail v))
                        ) (U.replicate (n+1) 0) (V.fromListN m $ BS.unpack s)
  where !m = BS.length s
        !n = BS.length t
        !t' = U.fromListN n (BS.unpack t)

solve :: BS.ByteString -> BS.ByteString -> BS.ByteString
solve s t = let !table = lcsTable s t
                !m = BS.length s
                !n = BS.length t
                recon !i !j | i >= m || j >= n = Nothing
                            | x == y = let !i' = i+1 ; !j' = j+1
                                       in Just (x, (i', j'))
                            | (table V.! (i+1)) U.! j >= (table V.! i) U.! (j+1) = recon (i+1) j
                            | otherwise = recon i (j+1)
                  where x = BS.index s i
                        y = BS.index t j
                (result, _) = BS.unfoldrN (fromIntegral $ (table V.! 0) U.! 0) (\(!i,!j) -> recon i j) (0,0)
            in result

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  if BS.length s <= BS.length t
    then BS.putStrLn (solve t s)
    else BS.putStrLn (solve s t)


{-# LANGUAGE BangPatterns, OverloadedStrings, MultiWayIf #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Int
import Data.Foldable
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 qualified Data.Set as S
import System.IO.Unsafe
import Debug.Trace

unew :: VUM.Unbox a => Int -> VUM.IOVector a
unew !n = accursedUnutterablePerformIO $ VUM.unsafeNew n

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

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

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

uset :: VUM.Unbox a => a -> VUM.IOVector a -> VUM.IOVector a
uset !a !v = accursedUnutterablePerformIO $ VUM.set v a >> return v

solve :: B.ByteString -> B.ByteString -> B.ByteString
solve !s !t = walk
 where
  toIndex !i !j = j * succ (B.length s) + i

  ifoldlB' :: (a -> Int -> Char -> a) -> a -> B.ByteString -> a
  ifoldlB' !f !x !bs = snd $ B.foldl'
    ( \(!i, !acc) !ch ->
      let i'   = i + 1
          acc' = f acc i ch
      in  i' `seq` acc' `seq` (i', acc')
    )
    (0, x)
    bs

  dp :: VU.Vector Int16
  dp = ufreeze $ ifoldlB'
    ( \(!dp) !i !si -> ifoldlB'
      ( \(!dp) !j !tj -> uwrite
        (toIndex (i + 1) (j + 1))
        ( if si == tj
          then uread (toIndex i j) dp + 1
          else max (uread (toIndex (i + 1) j) dp) (uread (toIndex i (j + 1)) dp)
        )
        dp
      )
      dp
      t
    )
    (uset 0 (unew $ succ (B.length s) * succ (B.length t)))
    s

  walk =
    fst
      $ B.unfoldrN (fromIntegral $ dp VU.! toIndex (B.length s) (B.length t))
                   (\(x:xs) -> Just $ (,) (B.index s x) xs)
      $ fst
      $ flip fix ([], (B.length s, B.length t))
      $ \(!f) (!acc, (!i, !j)) -> if
          | i == 0 || j == 0 -> (acc, (i, j))
          | s `B.index` (i - 1) == t `B.index` (j - 1) -> f
            ((i - 1) : acc, (i - 1, j - 1))
          | dp VU.! toIndex (i - 1) j < dp VU.! toIndex i (j - 1) -> f
            (acc, (i, j - 1))
          | otherwise -> f (acc, (i - 1, j))

main = do
  s <- B.getLine
  t <- B.getLine
  B.putStrLn $ solve s t


{-# LANGUAGE BangPatterns, OverloadedStrings #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Int
import Data.Foldable
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 qualified Data.Set as S
import System.IO.Unsafe
import Debug.Trace

unew :: VUM.Unbox a => Int -> VUM.IOVector a
unew !n = accursedUnutterablePerformIO $ VUM.unsafeNew n

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

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

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

uset :: VUM.Unbox a => a -> VUM.IOVector a -> VUM.IOVector a
uset !a !v = accursedUnutterablePerformIO $ VUM.set v a >> return v

solve :: B.ByteString -> B.ByteString -> B.ByteString
solve !s !t = walk
 where
  toIndex !i !j = j * succ (B.length s) + i

  ifoldlB' :: (a -> Int -> Char -> a) -> a -> B.ByteString -> a
  ifoldlB' !f !x !bs = snd $ B.foldl'
    ( \(!i, !acc) !ch ->
      let i'   = i + 1
          acc' = f acc i ch
      in  i' `seq` acc' `seq` (i', acc')
    )
    (0, x)
    bs

  dp :: VU.Vector Int16
  dp = ufreeze $ ifoldlB'
    ( \(!dp) !i !si -> ifoldlB'
      ( \(!dp) !j !tj -> uwrite
        (toIndex (i + 1) (j + 1))
        ( if si == tj
          then uread (toIndex i j) dp + 1
          else max (uread (toIndex (i + 1) j) dp) (uread (toIndex i (j + 1)) dp)
        )
        dp
      )
      dp
      t
    )
    (uset 0 (unew $ succ (B.length s) * succ (B.length t)))
    s

  walk =
    fst
      $ B.unfoldrN (fromIntegral $ dp VU.! toIndex (B.length s) (B.length t))
                   (\(x:xs) -> Just $ (,) (B.index s x) xs)
      $ fst
      $ fix
          ( \(!f) (!acc, (!i, !j)) -> if i == 0 || j == 0
            then (acc, (i, j))
            else if s `B.index` (i - 1) == t `B.index` (j - 1)
              then f ((i - 1) : acc, (i - 1, j - 1))
              else if dp VU.! toIndex (i - 1) j < dp VU.! toIndex i (j - 1)
                then f (acc, (i, j - 1))
                else f (acc, (i - 1, j))
          )
          ([], (B.length s, B.length t))

main = do
  s <- B.getLine
  t <- B.getLine
  B.putStrLn $ solve s t


{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Word
import qualified Data.ByteString as BSW
import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.Array.ST
--import qualified Data.Vector.Unboxed as U
--import qualified Data.Vector.Unboxed.Mutable as UM

-- Input: s t
-- Output: arr
--   arr ! (i,j) == length of lcs of (drop i s, drop j t)
lcsTable2 :: BS.ByteString -> BS.ByteString -> UArray (Int,Int) Word16
lcsTable2 s t = runSTUArray $ do
  let !m = BS.length s
      !n = BS.length t
      !n' = n+1
  arr <- newArray ((0,0),(m,n)) 0
  forM_ [m-1,m-2..0] $ \ !i -> do
    let !x = BSW.index s i
        loopY !j !v
          -- v = readArray arr (i,j+1)
          | j < 0 = return ()
          | otherwise = do
              let !y = BSW.index t j
              if x == y
                then do l2 <- readArray arr (i+1,j+1)
                        let !l = l2 + 1
                        writeArray arr (i,j) l
                        loopY (j-1) l
                else do l0 <- readArray arr (i+1,j)
                        let !l = max l0 v
                        writeArray arr (i,j) l
                        loopY (j-1) l
    loopY (n-1) 0
  return arr

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  let !table = lcsTable2 s t
      !m = BS.length s
      !n = BS.length t
      !n' = n+1
  let recon !i !j | x == y = let !i' = i+1 ; !j' = j+1
                             in Just (x, (i', j'))
                  | table ! (i+1,j) >= table ! (i,j+1) = recon (i+1) j
                  | otherwise = recon i (j+1)
        where x = BSW.index s i
              y = BSW.index t j
      (result, _) = BSW.unfoldrN (fromIntegral $ table ! (0,0)) (\(!i,!j) -> recon i j) (0,0)
  BS.putStrLn result


{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Word
import qualified Data.ByteString as BSW
import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.Array.ST

-- Input: s t
-- Output: arr
--   arr ! (i,j) == length of lcs of (drop i s, drop j t)
lcsTable2 :: BS.ByteString -> BS.ByteString -> UArray (Int,Int) Word16
lcsTable2 s t = runSTUArray $ do
  let !m = BS.length s
      !n = BS.length t
      !n' = n+1
  arr <- newArray ((0,0),(m,n)) 0
  forM_ [m-1,m-2..0] $ \ !i -> do
    let !x = BSW.index s i
        loopY !j !v
          -- v = readArray arr (i,j+1)
          | j < 0 = return ()
          | otherwise = do
              let !y = BSW.index t j
              if x == y
                then do l2 <- readArray arr (i+1,j+1)
                        let !l = l2 + 1
                        writeArray arr (i,j) l
                        loopY (j-1) l
                else do l0 <- readArray arr (i+1,j)
                        let !l = max l0 v
                        writeArray arr (i,j) l
                        loopY (j-1) l
    loopY (n-1) 0
  return arr

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  let !table = lcsTable2 s t
      !m = BS.length s
      !n = BS.length t
      !n' = n+1
  let recon !i !j | i >= m || j >= n = Nothing
                  | x == y = let !i' = i+1 ; !j' = j+1
                             in Just (x, (i', j'))
                  | table ! (i+1,j) >= table ! (i,j+1) = recon (i+1) j
                  | otherwise = recon i (j+1)
        where x = BSW.index s i
              y = BSW.index t j
      (result, _) = BSW.unfoldrN (fromIntegral $ table ! (0,0)) (\(!i,!j) -> recon i j) (0,0)
  BS.putStrLn result


{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Word
import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed
import Data.Array.ST

-- Input: s t
-- Output: arr
--   arr ! (i,j) == length of lcs of (drop i s, drop j t)
lcsTable2 :: BS.ByteString -> BS.ByteString -> UArray (Int,Int) Word16
lcsTable2 s t = runSTUArray $ do
  let !m = BS.length s
      !n = BS.length t
  arr <- newArray ((0,0),(m,n)) 0
  forM_ [m-1,m-2..0] $ \ !i -> do
    let !x = BS.index s i
    forM_ [n-1,n-2..0] $ \ !j -> do
      let !y = BS.index t j
      l <- if x == y
           then do l2 <- readArray arr (i+1, j+1)
                   return (l2 + 1)
           else do l0 <- readArray arr (i+1, j)
                   l1 <- readArray arr (i, j+1)
                   return (max l0 l1)
      writeArray arr (i,j) l
  return arr

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  let !table = lcsTable2 s t
      !m = BS.length s
      !n = BS.length t
  let recon !i !j | i >= m || j >= n = Nothing
                  | x == y = let !i' = i+1 ; !j' = j+1
                             in Just (x, (i', j'))
                  | table ! (i+1,j) >= table ! (i,j+1) = recon (i+1) j
                  | otherwise = recon i (j+1)
        where x = BS.index s i
              y = BS.index t j
      (result, _) = BS.unfoldrN (fromIntegral $ table ! (0,0)) (\(!i,!j) -> recon i j) (0,0)
  BS.putStrLn result


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

asSTUArray :: ST s (STUArray s i x) -> ST s (STUArray s i x)
asSTUArray x = x

-- Input: s
-- Output: arr
--   forall i x. let j = arr!(i,x) in j == -1 || (s `BS.index` j == x && all (\k -> s `BS.index` k /= x) [i..j-1])
indexTable :: BS.ByteString -> UArray (Int,Char) Int
indexTable s = runSTUArray $ do
  let n = BS.length s
  arr <- newArray ((0,'a'),(n - 1,'z')) (-1)
  t <- asSTUArray $ newArray ('a','z') (-1)
  forM_ [n-1,n-2..0] $ \i -> do
    let x = BS.index s i
    writeArray t x i
    forM_ ['a'..'z'] $ \y -> do
      j <- readArray t y
      writeArray arr (i,y) j
  return arr

lcsTable :: BS.ByteString -> BS.ByteString -> UArray (Int,Int) Int
lcsTable s t = runSTUArray $ do
  let m = BS.length s
      n = BS.length t
      t_tbl = indexTable t
  arr <- newArray ((0,0),(m,n)) 0
  forM_ [m-1,m-2..0] $ \i -> do
    let !x = BS.index s i
    forM_ [n-1,n-2..0] $ \j -> do
      l0 <- readArray arr (i+1, j)
      let k = t_tbl ! (j,x)
      if k /= -1
        then do l1 <- readArray arr (i+1, k+1)
                writeArray arr (i,j) $ max l0 (l1 + 1)
        else writeArray arr (i,j) l0
  return arr

main = do
  s <- BS.getLine
  t <- BS.getLine
  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
  let table = lcsTable s t
      n = BS.length s
      reconstruct i | i >= n = ""
                    | table ! (i,0) > table ! (i+1,0) = BS.index s i : reconstruct (i+1)
                    | otherwise = reconstruct (i+1)
  putStrLn (reconstruct 0)


import Data.List hiding (find)
import Data.Tree
--import Data.Array
import Data.Array.Unboxed
import Data.Array.MArray
import Data.Array.ST
--import Data.Vector as V
import Control.Monad
import Control.Monad.ST
import Control.Monad.State
import Debug.Trace

type Str = UArray Int Char
--type Table = UArray (Int,Int) Int --sl*tl matrix
type DP s = STUArray s (Int,Int) Int
type DPTable = UArray (Int,Int) Int -- == freeze $ DP s

dp_i :: DP s -> Str -> Str -> Int -> Int -> ST s ()
dp_i dparr s t i j = do
   dpij   <- readArray dparr (i,j)
   dpi1j1 <- readArray dparr (i-1,j-1)
   dpi1j  <- readArray dparr (i-1,j)
   dpij1  <- readArray dparr (i,j-1)
   if s!i == t!j then writeArray dparr (i,j) (max (dpi1j1+1) dpi1j1)
     else return ()
   writeArray dparr (i,j-1) (max dpi1j1 dpij1)
   writeArray dparr (i-1,j) (max dpi1j1 dpi1j)

--DPTableからStringを復元
mkans :: DPTable -> Str -> Int -> Int -> String
mkans dparr s i j
  | i == 0 || j == 0 = []
  | dparr!(i,j) == dparr!(i-1,j-1) = mkans dparr s (i-1) (j-1)
  | dparr!(i,j) == dparr!(i-1,j-1) + 1 =
    if dparr!(i,j) == dparr!(i-1,j) then mkans dparr s (i-1) j
    else if dparr!(i,j) == dparr!(i,j-1) then mkans dparr s i (j-1)
      else s!i : (mkans dparr s (i-1) (j-1))

solve :: Str -> Str -> Int -> Int -> ST s String
solve s t sl tl = do
  dparr <- newArray ((0,0),(sl,tl)) 0
  forM_ [1..sl] $ \i ->
    forM_ [1..tl] $ \j -> dp_i dparr s t i j
  dparr' <- freeze dparr
  let ans = reverse $ mkans dparr' s sl tl
  return ans

main :: IO ()
main = do
  s <- getLine
  t <- getLine
  let sl = length s
      tl = length t
      s' = listArray (1,sl) s
      t' = listArray (1,tl) t
  putStrLn $ runST $ solve s' t' sl tl


{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Char8 as B
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV

main=B.interact $ B.pack.g.take 2.B.lines
g [!s,!t]=mk "" (ls-1) (lt-1) where
    ls = B.length s
    lt = B.length t
    rd si ti = (aa V.! si) UV.! ti
    mk !as si ti
        | si<0 || ti<0 = as
        | B.index s si == B.index t ti = mk (B.index s si : as) (si-1) (ti-1)
        | rd (si+1) ti > rd si (ti+1) = mk as si (ti-1)
        | otherwise = mk as (si-1) ti
    aa :: V.Vector (UV.Vector Int)
    aa = V.scanl' p (UV.replicate (lt+1) 0) $ V.enumFromTo 1 ls where
        p v0 i = UV.scanl' m 0 $ UV.enumFromTo 1 lt where
            m pj j = if B.index s (i-1) == B.index t (j-1)
                then 1 + v0 UV.! (j-1)
                else max pj $ v0 UV.! j


import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV

main=B.interact $ B.pack.g.take 2.B.lines
g [s,t]=mk "" (ls-1) (lt-1) where
    ls = B.length s
    lt = B.length t
    rd si ti = (aa V.! si) UV.! ti
    mk as si ti
        | si<0 || ti<0 = as
        | B.index s si == B.index t ti = mk (B.index s si : as) (si-1) (ti-1)
        | rd (si+1) ti > rd si (ti+1) = mk as si (ti-1)
        | otherwise = mk as (si-1) ti
    aa :: V.Vector (UV.Vector Int)
    aa = V.scanl' p (UV.replicate (lt+1) 0) $ V.enumFromTo 1 ls
    p v0 i = UV.scanl' m 0 $ UV.enumFromTo 1 lt where
        m pj j = if B.index s (i-1) == B.index t (j-1)
            then 1 + v0 UV.! (j-1)
            else max pj $ v0 UV.! j


p d
    |d=="25"="Christmas"
    |d=="24"="Christmas Eve"
    |d=="23"="Christmas Eve Eve"
    |d=="22"="Christmas Eve Eve Eve"
main=do
    day <- getLine
    print $ p day

Score : 100 points

Problem Statement

In some other world, today is December D-th.

Write a program that prints Christmas if D = 25, Christmas Eve if D = 24, Christmas Eve Eve if D = 23 and Christmas Eve Eve Eve if D = 22.

Constraints

22 \leq D \leq 25

D is an integer.

Input

Input is given from Standard Input in the following format:

D

Output

Print the specified string (case-sensitive).

Sample Input 1

25

Sample Output 1

Christmas

Sample Input 2

22

Sample Output 2

Christmas Eve Eve Eve

Be sure to print spaces between the words.