has*_*eat 6 algorithm haskell functional-programming
这是 Kattis 提出的一个非常标准的背包问题。下面是 Haskell 中一个简单的动态编程解决方案：
{-# Language OverloadedStrings #-}
import Control.Arrow ((>>>))
import Data.List (intercalate)
import Data.Array
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as C
main = C.interact solve
solve = C.words >>> fmap readInt >>> divideInput
>>> fmap (solveCase >>> toBS)
>>> C.unlines
where readInt = C.readInt >>> fromJust >>> fst
divideInput :: [Int] -> [[Int]]
divideInput [] = []
divideInput (c:n:ls) = (c : n : this) : divideInput that
where (this, that) = splitAt (2*n) ls
solveCase :: [Int] -> [[Int]]
solveCase (c:n:os) = [[length is], is]
where is = recover (n, c) []
recover (i, j) rs | table ! (i, j) == 0 = rs
| table ! (i, j) == table ! (i-1, j) =
recover (i-1, j) rs
| table ! (i, j) == vi + (table ! (i-1, j-wi)) =
recover (i-1, j-wi) ((i-1):rs)
where (vi, wi) = objs ! i
objs :: Array Int (Int, Int)
objs = listArray (1, n) $ pairs os
pairs [] = []
pairs (v:w:os) = (v,w) : pairs os
-- table[i][j] is the max value that can be achieved with
-- objects [1..i] where the total weight of selected
-- objects is <= j.
table :: Array (Int, Int) Int
table = array bnds [(ij, fill ij) | ij <- range bnds]
where
bnds = ((0,0), (n,c))
fill (i, w) | i == 0 || w == 0 = 0
| w < wi = vx
| otherwise = max vx (vy+vi)
where vx = table ! (i-1, w)
vy = table ! (i-1, w - wi)
(vi, wi) = objs ! i
toBS :: [[Int]] -> C.ByteString
toBS [[n], is] = C.intercalate "\n"
[C.pack (show n), C.intercalate " " $ C.pack . show <$> is]
然而，一旦提交给 Kattis，代码就会给出 TLE，考虑到其O(Cn)复杂度（从最大容量C的n 个对象中选取），这似乎令人惊讶。有人对如何解决这个问题有任何建议吗？
我已经尝试过在 ST monad 中使用可变数组。但可变数组在这里没有帮助，这并不奇怪，因为 DP 数组永远不需要更新。
在 C=2000、n=2000 上对其进行分析，值和权重均匀地在 1 到 20000 之间随机选取。大约需要 1.16 秒。完整简介如下：
523,035,224 bytes allocated in the heap
598,289,064 bytes copied during GC
144,045,528 bytes maximum residency (4 sample(s))
662,056 bytes maximum slop
254 MiB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 464 colls, 0 par 0.374s 0.394s 0.0008s 0.0196s
Gen 1 4 colls, 0 par 0.141s 0.202s 0.0505s 0.1067s
INIT time 0.000s ( 0.004s elapsed)
MUT time 0.651s ( 0.664s elapsed)
GC time 0.515s ( 0.596s elapsed)
EXIT time 0.000s ( 0.001s elapsed)
Total time 1.166s ( 1.265s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 804,028,826 bytes per MUT second
Productivity 55.8% of total user, 52.5% of total elapsed
刚刚设法使用 IOUArray 和 IOArray 获得了可接受的变体。还需要调整代码以尽可能减少列表的使用。1.61 秒被接受。
我很早就尝试过 STUArray/STArray，并认为它们会提供与 IOUArray/IOArray 相同的性能。然而，事实证明，即使基于 STUArray/STArray 的解决方案使用的内存和时间少于功能数组，它仍然无法通过 TLE 的最后一个测试文件。
我看到最快接受的 Haskell 解决方案只用了 0.38 秒。我很好奇他们做了什么才能让它这么快。下面附有我接受的代码以及一些个人资料信息。欢迎任何进一步提高其性能的想法。
{-# Language OverloadedStrings #-}
import Control.Arrow ((>>>))
import Control.Monad
import Data.List (intercalate)
import Data.Array.IO
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as C
main = do
inStr <- C.getContents
solveCases $ (C.words >>> fmap readInt) inStr
where readInt = C.readInt >>> fromJust >>> fst
solveCases :: [Int] -> IO ()
solveCases [] = return ()
solveCases (c:n:os) = do
objs <- newArray (1, n) (0,0)
os' <- fillObj objs n os
table <- buildTable objs
indices <- recover table objs n c []
putStrLn $ show $ length indices
putStrLn $ intercalate " " $ show <$> indices
solveCases os'
where
recover :: IOUArray (Int, Int) Int ->
IOArray Int (Int, Int) ->
Int -> Int -> [Int] -> IO [Int]
recover table objs i j rs = do
v <- readArray table (i, j)
if (v == 0)
then return rs
else do
v' <- readArray table (i-1, j)
if (v == v')
then recover table objs (i-1) j rs
else do
(_, wi) <- readArray objs i
recover table objs (i-1) (j-wi) ((i-1):rs)
fillObj :: IOArray Int (Int, Int) -> Int -> [Int] -> IO [Int]
fillObj objs n vws = go 1 vws
where go :: Int -> [Int] -> IO [Int]
go i (v:w:vws) | i == n = writeArray objs i (v, w) >> return vws
| otherwise = do
writeArray objs i (v, w)
go (i+1) vws
bnds = ((0,0), (n,c))
-- table[i][j] is the max value that can be achieved with
-- objects [0..i] such that the max selected weight is <= j.
buildTable :: IOArray Int (Int, Int) -> IO (IOUArray (Int, Int) Int)
buildTable objs = do
table <- newArray bnds 0
forM_ (range bnds) $ \(i, w) -> do
when (i > 0 && w > 0) $ do
(vi, wi) <- readArray objs i
vx <- readArray table (i-1, w)
if (w < wi)
then do
writeArray table (i, w) vx
else do
vy <- readArray table (i-1, w-wi)
writeArray table (i, w) $ max vx (vy+vi)
return table
33,901,296 bytes allocated in the heap
183,504 bytes copied during GC
53,320 bytes maximum residency (1 sample(s))
36,792 bytes maximum slop
33 MiB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 2 colls, 0 par 0.000s 0.000s 0.0001s 0.0002s
Gen 1 1 colls, 0 par 0.000s 0.003s 0.0025s 0.0025s
INIT time 0.000s ( 0.004s elapsed)
MUT time 0.040s ( 0.048s elapsed)
GC time 0.000s ( 0.003s elapsed)
EXIT time 0.000s ( 0.006s elapsed)
Total time 0.040s ( 0.061s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 847,130,013 bytes per MUT second
Productivity 98.9% of total user, 79.3% of total elapsed