6

在解决 projecteuler.net 的问题 #31 [ SPOILERS AHEAD ]（计算用英国硬币赚 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 的人的意见，为什么这个解决方案的性能如此糟糕。

4

2 回答 2

11

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

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

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

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

所用算法的效率依赖于可变数据结构，但可变性仅限于计算，因此我们可以使用旨在允许安全屏蔽计算的方法，包括临时可变数据、ST状态转换器 monad 系列以及相关的 [unboxed , 为了提高效率] 数组。

给我半个小时左右的时间用STUArrays 将算法翻译成代码，你会得到一个不会太难看的 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 代码使用任意精度整数，因此Int在 Haskell 中使用会使 O'Caml 处于不公平的劣势。Integer以任意精度s计算结果所需的更改是最小的，

$ 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

对于Ints 溢出的大结果的计算明显需要更长的时间，但正如预期的那样，与 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
于 2012-12-14T01:33:37.387 回答
4

您可以利用 Haskell 的惰性而不是自己安排填充数组，而是依靠惰性求值以正确的顺序执行。（对于大型输入，您需要增加堆栈大小。）

import Data.Array

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


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

main =
    print $ changeCombinations 200 [1,2,5,10,20,50,100,200]
于 2012-12-14T09:55:45.470 回答