优化 Haskell 递归列表答案

【问题标题】：Optimizing Haskell Recursive Lists优化 Haskell 递归列表
【发布时间】：2011-11-15 19:36:35
【问题描述】：

来自previous 的另一个 Haskell 优化问题。我需要递归生成一个列表，类似于许多介绍性 Haskell 文章中的 fibs 函数：

generateSchedule :: [Word32] -> [Word32]
generateSchedule blkw = take 80 ws
    where
    ws          = blkw ++ zipWith4 gen (drop 13 ws) (drop 8 ws) (drop 2 ws) ws
    gen a b c d = rotate (a `xor` b `xor` c `xor` d) 1

对我来说，上述函数已成为最耗时和最耗费分配的函数。探查器给了我以下统计数据：

COST CENTRE        MODULE             %time %alloc  ticks     bytes
generateSchedule   Test.Hash.SHA1     22.1   40.4   31        702556640

我曾想过应用未装箱的向量来计算列表，但由于列表是递归的，因此无法找到方法。这在 C 中会有一个自然的实现，但我看不出有什么方法可以让它更快（除了展开和编写 80 行变量声明）。有什么帮助吗？

更新：实际上我确实快速展开它以查看它是否有帮助。代码是here。它很丑，实际上它更慢。

COST CENTRE        MODULE             %time %alloc  ticks     bytes
generateSchedule   GG.Hash.SHA1       22.7   27.6   40        394270592

【问题讨论】：

我仍然认为您需要完全放弃列表。不仅仅是作为中介，将您的数据输入为ByteString 并使用 Data.Vector.Storable 或类似的。当输入是单词列表时，我认为优化没有多大意义。如果你完全展开partcb，那么你甚至不需要这个generateSchedule 函数（partab）；在展开时它将是明确的（内联的）。另外：您为此付出了足够的努力，我对目标感到好奇-是教育还是您想在生产代码中使用实现？如果#2，是否有理由避免cryptohash？
教育。我想知道我是否可以编写干净、惯用的 Haskell，它的速度相当，而无需求助于让我希望我只是用 C 语言编写的优化技巧。在 SHA1 的情况下，我开始觉得情况就是这样。我还查看了Data.Digest.Pure.SHA 的来源。这很棒——速度是 C 实现速度的 2-3 倍。但这不是我想写的那种代码。
仅供参考我的完整最新代码here。
只需解压 Vec160 结构（在每个 Word32 字段之前使用 {-# UNPACK #-} pragma），即可获得 23% 的廉价提升
你确定generateSchedule实际上是这里的瓶颈吗？如果blkw 尚未评估，评估它的成本可能会归于generateSchedule。如果它被评估，那么用列表表示它可能不是正确的事情。

标签： optimization haskell

【解决方案1】：

import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed

generateSchedule :: [Word32] -> UArray Int Word32
generateSchedule ws0 = runSTUArray $ do
    arr <- unsafeNewArray_ (0,79)
    let fromList i [] = fill i 0
        fromList i (w:ws) = do
            unsafeWrite arr i w
            fromList (i+1) ws
        fill i j
          | i == 80 = return arr
          | otherwise = do
              d <- unsafeRead arr j
              c <- unsafeRead arr (j+2)
              b <- unsafeRead arr (j+8)
              a <- unsafeRead arr (j+13)
              unsafeWrite arr i (gen a b c d)
              fill (i+1) (j+1)
    fromList 0 ws0

将创建一个与您的列表相对应的未装箱数组。它依赖于 list 参数包含至少 14 个和最多 80 个项目的假设，否则它会表现不佳。我认为它总是 16 项（64 字节），所以这对你来说应该是安全的。（但最好直接从 ByteString 开始填充，而不是构造一个中间列表。）

通过在进行散列循环之前严格评估这一点，您可以节省列表构造和使用惰性构造列表的散列之间的切换，这应该会减少所需的时间。通过使用未装箱的数组，我们避免了列表的分配开销，这可能会进一步提高速度（但 ghc 的分配器非常快，所以不要期望有太大的影响）。

在您的哈希回合中，通过unsafeAt array t 获取所需的Word32 以避免不必要的边界检查。

附录：如果您对每个 wn 都放一下，展开列表的创建可能会更快，但我不确定。既然你已经有了代码，添加刘海和检查不是太多的工作，是吗？我很好奇。

【讨论】：

你好丹尼尔。我按照你的建议做了。刘海后的数字分别为 13.4%、15.7% 和前刘海后的 30%、27%。所以它减少了大约一半的运行时间和分配。好主意。
重新向量解。谢谢。但是我并没有因为所有 unsafe* 电话而从中得到温暖的模糊感。此外，Haskell 的优势，即清晰、简洁，被争吵的代码速度所掩盖。如果我必须这样做，我想我会按照最初的建议用 C 语言编写它。
这里，“不安全”只是意味着没有边界检查（在unsafeNewArray_ 中没有初始化）。由于边界检查在调用代码中，它实际上是安全的（如果ws0 长度的前提条件成立）。这是一个不幸的命名，最好调用函数uncheckedXXX。至于清晰度和简洁性，嗯，这是一个权衡。在我们获得更多编译器和融合魔法之前，有时您必须编写难看的命令式代码。但它在 Haskell 中更加本地化，一旦低级别达到鼻烟，使用代码可以很好且组合。

【解决方案2】：

我们可以使用惰性数组在直接可变数组和使用纯列表之间找到一个折中点。你得到了递归定义的好处，但由于这个原因，仍然要付出懒惰和装箱的代价——尽管不如使用列表。下面的代码使用criteria来测试两个惰性数组解决方案（使用标准数组和向量）以及上面的原始列表代码和丹尼尔的可变uarray代码：

module Main where
import Data.Bits
import Data.List
import Data.Word
import qualified Data.Vector as LV
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.Array as A
import Data.Array.Base
import Criterion.Main

gen :: Word32 -> Word32 -> Word32 -> Word32 -> Word32
gen a b c d = rotate (a `xor` b `xor` c `xor` d) 1

gss blkw = LV.toList v
    where v = LV.fromList $ blkw ++ rest
          rest = map (\i -> gen (LV.unsafeIndex v (i + 13))
                                (LV.unsafeIndex v (i + 8))
                                (LV.unsafeIndex v (i + 2))
                                (LV.unsafeIndex v i)
                     )
                 [0..79 - 14]

gss' blkw = A.elems v
    where v = A.listArray (0,79) $ blkw ++ rest
          rest = map (\i -> gen (unsafeAt v (i + 13))
                                (unsafeAt v (i + 8))
                                (unsafeAt v (i + 2))
                                (unsafeAt v i)
                     )
                 [0..79 - 14]

generateSchedule :: [Word32] -> [Word32]
generateSchedule blkw = take 80 ws
    where
    ws          = blkw ++ zipWith4 gen (drop 13 ws) (drop 8 ws) (drop 2 ws) ws

gs :: [Word32] -> [Word32]
gs ws = elems (generateSched ws)

generateSched :: [Word32] -> UArray Int Word32
generateSched ws0 = runSTUArray $ do
    arr <- unsafeNewArray_ (0,79)
    let fromList i [] = fill i 0
        fromList i (w:ws) = do
            unsafeWrite arr i w
            fromList (i+1) ws
        fill i j
          | i == 80 = return arr
          | otherwise = do
              d <- unsafeRead arr j
              c <- unsafeRead arr (j+2)
              b <- unsafeRead arr (j+8)
              a <- unsafeRead arr (j+13)
              unsafeWrite arr i (gen a b c d)
              fill (i+1) (j+1)
    fromList 0 ws0

args = [0..13]

main = defaultMain [
        bench "list"   $ whnf (sum . generateSchedule) args
       ,bench "vector" $ whnf (sum . gss) args
       ,bench "array"  $ whnf (sum . gss') args
       ,bench "uarray" $ whnf (sum . gs) args
       ]

我使用-O2 和-funfolding-use-threshold=256 编译代码以强制进行大量内联。

标准基准表明矢量解决方案略好，数组解决方案略好，但未装箱的可变解决方案仍以压倒性优势获胜：

benchmarking list
mean: 8.021718 us, lb 7.720636 us, ub 8.605683 us, ci 0.950
std dev: 2.083916 us, lb 1.237193 us, ub 3.309458 us, ci 0.950

benchmarking vector
mean: 6.829923 us, lb 6.725189 us, ub 7.226799 us, ci 0.950
std dev: 882.3681 ns, lb 76.20755 ns, ub 2.026598 us, ci 0.950

benchmarking array
mean: 6.212669 us, lb 5.995038 us, ub 6.635405 us, ci 0.950
std dev: 1.518521 us, lb 946.8826 ns, ub 2.409086 us, ci 0.950

benchmarking uarray
mean: 2.380519 us, lb 2.147896 us, ub 2.715305 us, ci 0.950
std dev: 1.411092 us, lb 1.083180 us, ub 1.862854 us, ci 0.950

我也运行了一些基本的分析，并注意到惰性/盒装数组解决方案的性能略好于列表解决方案，但再次明显比未装箱数组方法差。

【讨论】：

严格来说，应该是[0..79 - length blkw]（即[0..15]，因为Ana 总是会给出这个长度为64 的列表），但是您使用LV.take 作为备份（智能）。我很好奇是否有任何可测量的差异。同时，我也懒得去查了。
@Thomas：是的，我冲掉了代码并很快测试了它，因此对一些事情很懒惰。我将在接下来的一天左右运行一些基准测试并进行调整和更新。