haskell - 在 Haskell 中使用动态编程？ [警告: ProjectEuler 31 solution inside]

Question

在解决projecteuler.net 的问题 #31 [剧透](计算用英国硬币赚 2 英镑的方法数)时，我想使用动态规划。我从 OCaml 开始，编写了以下简短且非常高效的编程:

open Num

let make_dyn_table amount coins =
  let t = Array.make_matrix (Array.length coins) (amount+1) (Int 1) in
  for i = 1 to (Array.length t) - 1 do
    for j = 0 to amount do
      if j < coins.(i) then
        t.(i).(j) <- t.(i-1).(j)
      else
        t.(i).(j) <- t.(i-1).(j) +/ t.(i).(j - coins.(i))
    done
  done;
  t

let _ =
  let t = make_dyn_table 200 [|1;2;5;10;20;50;100;200|] in
  let last_row = Array.length t - 1 in
  let last_col = Array.length t.(last_row) - 1 in
  Printf.printf "%s\n" (string_of_num (t.(last_row).(last_col)))

这在我的笔记本电脑上执行大约需要 8 毫秒。如果我将金额从 200 便士增加到 100 万便士，程序仍然会在不到两秒的时间内找到答案。

我将程序翻译成 Haskell(这本身绝对不好玩)，虽然它以 200 便士的正确答案结束，但如果我将这个数字增加到 10000，我的笔记本电脑就会突然停止(大量的抖动) )。代码如下:

import Data.Array

createDynTable :: Int -> Array Int Int -> Array (Int, Int) Int
createDynTable amount coins =
    let numCoins = (snd . bounds) coins
        t = array ((0, 0), (numCoins, amount))
            [((i, j), 1) | i <- [0 .. numCoins], j <- [0 .. amount]]
    in t

populateDynTable :: Array (Int, Int) Int -> Array Int Int -> Array (Int, Int) Int
populateDynTable t coins =
    go t 1 0
        where go t i j
                 | i > maxX = t
                 | j > maxY = go t (i+1) 0
                 | j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1)
                 | otherwise = go (t // [((i, j), t!(i-1,j) + t!(i, j - coins!i))]) i (j+1)
              ((_, _), (maxX, maxY)) = bounds t

changeCombinations amount coins =
    let coinsArray = listArray (0, length coins - 1) coins
        dynTable = createDynTable amount coinsArray
        dynTable' = populateDynTable dynTable coinsArray
        ((_, _), (i, j)) = bounds dynTable
    in
      dynTable' ! (i, j)

main =
    print $ changeCombinations 200 [1,2,5,10,20,50,100,200]

我很想听听熟悉 Haskell 的人的意见，为什么这个解决方案的性能如此糟糕。

Answer 1

Haskell 是纯粹的。纯度意味着值是不可变的，因此在步骤中

j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1)

您为更新的每个条目创建一个全新的数组。对于 2 英镑这样的小金额来说，这已经非常昂贵了，但对于 100 英镑的金额来说，这就变得完全令人不齿了。

此外，数组是装箱的，这意味着它们包含指向条目的指针，这会恶化局部性，使用更多存储空间，并允许构建 thunk，当它们最终被强制时，评估速度也更慢。

所使用的算法取决于可变数据结构的效率，但可变性仅限于计算，因此我们可以使用旨在允许使用临时可变数据进行安全屏蔽计算的东西，ST 状态转换器 monad 系列，以及相关的[未装箱，以提高效率]数组。

给我半个小时左右的时间，使用 STUArray 将算法转换为代码，您将得到一个不太难看的 Haskell 版本，并且性能应该与 O' 相当Caml 版本(对于差异，预计会有一些或多或少的常数因子，无论它是大于还是小于 1，我不知道)。

这里是:

module Main (main) where

import System.Environment (getArgs)

import Data.Array.ST
import Control.Monad.ST
import Data.Array.Unboxed

standardCoins :: [Int]
standardCoins = [1,2,5,10,20,50,100,200]

changeCombinations :: Int -> [Int] -> Int
changeCombinations amount coins = runST $ do
    let coinBound = length coins - 1
        coinsArray :: UArray Int Int
        coinsArray = listArray (0, coinBound) coins
    table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int)
    let go i j
            | i > coinBound = readArray table (coinBound,amount)
            | j > amount   = go (i+1) 0
            | j < coinsArray ! i = do
                v <- readArray table (i-1,j)
                writeArray table (i,j) v
                go i (j+1)
            | otherwise = do
                v <- readArray table (i-1,j)
                w <- readArray table (i, j - coinsArray!i)
                writeArray table (i,j) (v+w)
                go i (j+1)
    go 1 0

main :: IO ()
main = do
    args <- getArgs
    let amount = case args of
                   a:_ -> read a
                   _   -> 200
    print $ changeCombinations amount standardCoins

运行时间不太短，

$ time ./mutArr
73682

real    0m0.002s
user    0m0.000s
sys     0m0.001s
$ time ./mutArr 1000000
986687212143813985

real    0m0.439s
user    0m0.128s
sys     0m0.310s

并且使用检查的数组访问，使用未检查的访问，时间可能会有所减少。

<小时/>

啊，我刚刚了解到您的 O'Caml 代码使用任意精度整数，因此在 Haskell 中使用 Int 会使 O'Caml 处于不公平的劣势。以任意精度整数计算结果所需的更改是最小的，

$ diff mutArr.hs mutArrIgr.hs
12c12
< changeCombinations :: Int -> [Int] -> Int
---
> changeCombinations :: Int -> [Int] -> Integer
17c17
<     table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int)
---
>     table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer)
28c28
<                 writeArray table (i,j) (v+w)
---
>                 writeArray table (i,j) $! (v+w)

只需要调整两个类型签名 - 数组必然会被装箱，因此我们需要确保我们没有在第 28 行中向数组写入 thunk，并且

$ time ./mutArrIgr 
73682

real    0m0.002s
user    0m0.000s
sys     0m0.002s
$ time ./mutArrIgr 1000000
99341140660285639188927260001

real    0m1.314s
user    0m1.157s
sys     0m0.156s

Int 溢出的大结果的计算时间明显更长，但正如预期的那样，与 O'Caml 相当。

<小时/>

花一些时间理解 O'Caml，我可以提供一个更接近、更短、可以说更好的翻译:

module Main (main) where

import System.Environment (getArgs)

import Data.Array.ST
import Control.Monad.ST
import Data.Array.Unboxed
import Control.Monad (forM_)

standardCoins :: [Int]
standardCoins = [1,2,5,10,20,50,100,200]

changeCombinations :: Int -> [Int] -> Integer
changeCombinations amount coins = runST $ do
    let coinBound = length coins - 1
        coinsArray :: UArray Int Int
        coinsArray = listArray (0, coinBound) coins
    table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer)
    forM_ [1 .. coinBound] $ \i ->
        forM_ [0 .. amount] $ \j ->
            if j < coinsArray!i
              then do
                  v <- readArray table (i-1,j)
                  writeArray table (i,j) v
              else do
                v <- readArray table (i-1,j)
                w <- readArray table (i, j - coinsArray!i)
                writeArray table (i,j) $! (v+w)
    readArray table (coinBound,amount)

main :: IO ()
main = do
    args <- getArgs
    let amount = case args of
                   a:_ -> read a
                   _   -> 200
    print $ changeCombinations amount standardCoins

运行速度大致相同:

$ time ./mutArrIgrM 1000000
99341140660285639188927260001

real    0m1.440s
user    0m1.273s
sys     0m0.164s