Problem:
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

Solution in Haskell (GHC 7.10.3) (judge verdict: Accepted)

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