📚
Haskellで蟻本やるぜ5（DP）
前回の続き。
もはやLVS7K'S BLOGの写経になりつつあるが。
今回からDP（動的計画法）をやるぜ。
サンプルデータは、ここから借用したぜ。
2-3 ナップサック問題
毎度、ここをほぼパクリにしたお。
-- https://lvs7k.github.io/posts/2018/11/pccb-easy-3/
-- https://download-takeshi.hatenablog.com/entry/20100301/1267476665
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array
import Data.Time
-- 01 ナップサック問題
q1 :: Int -> Int -> [(Int, Int)] -> Int
q1 n m wvs = go n m
where
wva = listArray (1, n) wvs
-- 蟻本のiを増やしていくパターン
memo = listArray ((0, 0), (n, m)) [go i j | i <- [0 .. n], j <- [0 .. m]]
go 0 _ = 0
go i j
| j < w = x1 -- 荷物が入らない
| otherwise = max x1 x2 -- 入れる場合と入れない場合の両方を試す
where
(w, v) = wva ! i
-- 荷物を入れる場合
x1 = memo ! (i - 1, j)
-- 荷物を入れない場合
x2 = memo ! (i - 1, j - w) + v
q1' :: Int -> Int -> [(Int, Int)] -> Int
q1' n m wvs = runST $ do
dp <- newArray ((0, 0), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
forM_ [1 .. n] $ \i -> do
-- 荷物データから重さと価値を取得
let (w, v) = wva ! i
-- dp
forM_ [0 .. m] $ \j -> do
x1 <- readArray dp (i - 1, j)
if j < w then
writeArray dp (i, j) x1
else do
x2 <- readArray dp (i - 1, j - w)
writeArray dp (i, j) (max x1 (x2 + v))
readArray dp (n, m)
where
-- 荷物データ
wva = listArray (1, n) wvs
q1'' :: Int -> Int -> [(Int, Int)] -> Int
q1'' n m wvs = 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)
-- sequence_ は、(モナドの)リストを取り、要素を順に実行して、値は返さない関数
-- memoがn=0のときは、0を返させるよう初期化（True:計算済みにしておく）
sequence_ [writeArray memo (0, i) True | i <- [0 .. m]]
go dp memo (n, m)
where
wva = listArray (1, n) wvs
go dp memo (i, j) = do
exists <- readArray memo (i, j)
-- まだ計算していない場合
when (not exists) $ do
let (w, v) = wva ! i
x1 <- go dp memo (i - 1, j)
if j < w
then do
writeArray dp (i, j) x1
else do
x2 <- go dp memo (i - 1, j - w)
writeArray dp (i, j) (max x1 (x2 + v))
writeArray memo (i, j) True
readArray dp (i, j)
main :: IO ()
main = do
x <- getCurrentTime
-- let ret = q1 4 5 [(2,3),(1,2),(3,4),(2,2)]
let ret = q1 10 300 [(168,496),(10,45),(145,325),(60,347),(10,61),(124,486),(124,446),(105,22),(126,110),(184,475)]
print ret
y <- getCurrentTime
print $ diffUTCTime y x
x' <- getCurrentTime
--let ret' = q1' 4 5 [(2,3),(1,2),(3,4),(2,2)]
let ret' = q1' 10 300 [(168,496),(10,45),(145,325),(60,347),(10,61),(124,486),(124,446),(105,22),(126,110),(184,475)]
print ret'
y' <- getCurrentTime
print $ diffUTCTime y' x'
x'' <- getCurrentTime
--let ret'' = q1'' 4 5 [(2,3),(1,2),(3,4),(2,2)]
let ret'' = q1'' 10 300 [(168,496),(10,45),(145,325),(60,347),(10,61),(124,486),(124,446),(105,22),(126,110),(184,475)]
print ret''
y'' <- getCurrentTime
print $ diffUTCTime y'' x''
x <- getCurrentTime
-- let ret = q1 4 5 [(2,3),(1,2),(3,4),(2,2)]
let ret = q1 10 300 [(168,496),(10,45),(145,325),(60,347),(10,61),(124,486),(124,446),(105,22),(126,110),(184,475)]
print ret
y <- getCurrentTime
print $ diffUTCTime y x
q1 が純粋にHaskellでメモ化しながら説いている
q1' はDPを使っている
q1''はDPとメモ化の両方を使っている
mainで時間測定しつつ、q1とq1'とq1''を実行している。
メモリキャッシュの関係か、2回目の実行が早いので、q1は2回実行している。
q1よりもDPを使っているq1'の方が速いぜ！と思っていたら違った。
$ ./sample
1038
0.000669s
1038
0.002878s
1038
0.000464s
1038
0.0002s
ということで、プロファイルを取ってみる。
それぞれの関数を別ファイルにして、実行してみた。
q1 純情メモ
$ stack ghc sample1.hs
$ ./sample1 +RTS -s
1038
0.000748s
860,480 bytes allocated in the heap
3,480 bytes copied during GC
44,576 bytes maximum residency (1 sample(s))
25,056 bytes maximum slop
0 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 0 colls, 0 par 0.000s 0.000s 0.0000s 0.0000s
Gen 1 1 colls, 0 par 0.000s 0.000s 0.0002s 0.0002s
INIT time 0.000s ( 0.003s elapsed)
MUT time 0.000s ( 0.001s elapsed)
GC time 0.000s ( 0.000s elapsed)
EXIT time 0.000s ( 0.011s elapsed)
Total time 0.001s ( 0.015s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 1,964,566,210 bytes per MUT second
Productivity 51.6% of total user, 6.1% of total elapsed
まぁ、こんなもんでしょ
DP
$ stack ghc sample2.hs
$ ./sample2 +RTS -s
1038
0.003429s
7,447,424 bytes allocated in the heap
21,008 bytes copied during GC
56,640 bytes maximum residency (2 sample(s))
29,152 bytes maximum slop
0 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 6 colls, 0 par 0.000s 0.000s 0.0000s 0.0000s
Gen 1 2 colls, 0 par 0.000s 0.000s 0.0001s 0.0002s
INIT time 0.000s ( 0.002s elapsed)
MUT time 0.003s ( 0.003s elapsed)
GC time 0.000s ( 0.000s elapsed)
EXIT time 0.000s ( 0.008s elapsed)
Total time 0.003s ( 0.014s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 2,763,422,634 bytes per MUT second
Productivity 82.6% of total user, 24.0% of total elapsed
heapメモリを7.4MBも使っているお。
DP+メモ化
$ stack ghc sample3.hs
$ ./sample3 +RTS -s
1038
0.001582s
1,263,504 bytes allocated in the heap
10,200 bytes copied during GC
44,576 bytes maximum residency (1 sample(s))
29,152 bytes maximum slop
0 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 1 colls, 0 par 0.000s 0.000s 0.0000s 0.0000s
Gen 1 1 colls, 0 par 0.000s 0.000s 0.0002s 0.0002s
INIT time 0.000s ( 0.003s elapsed)
MUT time 0.001s ( 0.002s elapsed)
GC time 0.000s ( 0.000s elapsed)
EXIT time 0.000s ( 0.009s elapsed)
Total time 0.001s ( 0.014s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 1,294,573,770 bytes per MUT second
Productivity 68.4% of total user, 12.0% of total elapsed
メモリ使用量は、1.2MBでましになった。
メモ化だけで、DPに勝てるのはうれしい。
Haskellで、単純にDPにするとArray使うから手続き型で書いているのと変わらん。
しかし、おかしいなぁ。
データが少ないからかなぁ。
続きを書いたぜ。
大量データの場合は、結果が変わったぜ。
Discussion