algorithm - "Time Limit Exceeded"用于背包的 Haskell 解决方案

Question

这是一个非常标准的Knapsack来自 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

Answer 1

刚刚设法使用 IOUArray 和 IOArray 获得了可接受的变体。还需要调整代码以尽可能减少 Lists 的使用。接受 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