Haskellで動的計画法(最長共通部分列問題)
蟻本の「最長共通部分列問題」(56p)をHaskellで実装してみた。
Haskellでの動的計画法(DP)の実装方法が全然わからなかったので、以下のリンクを参考にした - Haskellで蟻本やるぜ5(DP)
{-# LANGUAGE BangPatterns, FlexibleContexts #-} import Control.Monad import Control.Monad.ST import Data.Array import Data.Array.ST import Data.Time import Debug.Trace -- 最長共通部分列問題 -- 再帰(Data.Array) solver :: Int -> Int -> [String] -> [String] -> Int solver n m ss ts = rec n m where memo = listArray ((0, 0), (n, m)) [rec i j | i <- [n..0], j <- [m..0]] -- rec 0 _ = 0 rec _ 0 = 0 rec i j = if si == tj then 1 + rec (pred i) (pred j) else max (rec (pred i) j) (rec i (pred j)) where si = ss !! (pred i) tj = ts !! (pred j) -- STモナド solver' :: Int -> Int -> [String] -> [String] -> Int solver' n m ss ts = runST $ do dp <- newArray ((0, 0), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int) forM_ [0..(pred n)] $ \i -> do let si = ss !! i forM_ [0..(pred m)] $ \j -> do let tj = ts !! j if si == tj then do x <- readArray dp (i, j) writeArray dp (succ i, succ j) (x + 1) else do x1 <- readArray dp (i, succ j) x2 <- readArray dp (succ i, j) writeArray dp (succ i, succ j) (max x1 x2) readArray dp (n, m) -- STモナド&再帰 solver'' :: Int -> Int -> [String] -> [String] -> Int solver'' n m ss ts = runST $ do dp <- newArray ((0, 0), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int) memo <- newArray ((0, 0), (n, m)) False :: ST s (STUArray s (Int, Int) Bool) -- (0, _), (_, 0)のときは0なので計算済みにしておく sequence [writeArray memo (0, i) True | i <- [0..m]] sequence [writeArray memo (i, 0) True | i <- [0..m]] rec dp memo (n, m) where rec dp memo (i, j) = do exists <- readArray memo (i, j) when (not exists) $ do let si = ss !! (pred i) tj = ts !! (pred j) if si == tj then do x <- rec dp memo (pred i, pred j) writeArray dp (i, j) (x + 1) else do x1 <- rec dp memo (pred i, j) x2 <- rec dp memo (i, pred j) writeArray dp (i, j) (max x1 x2) writeArray memo (i, j) True readArray dp (i, j) main = do -- answer : 3 let n = 4 m = 4 s = "abcd" t = "becd" print $ solver n m (map (:[]) s) (map (:[]) t) print $ solver' n m (map (:[]) s) (map (:[]) t) print $ solver'' n m (map (:[]) s) (map (:[]) t)
実装した感じだと、2番目の「STモナド」利用が、元のソースと同じような感覚で書けた。
C++から移植する際は2番目の書き方ベースで進めると良いかもしれない。