求和树的高效折叠

Question

在这个earlier question 中，我询问了如何编写一个对非二进制整数树求和的函数，并且出现了几个答案。

@Sibi 说：

data Tree a = Empty | Node a [Tree a] deriving (Eq, Show)

addNums :: (Num a) => Tree a -> a
addNums Empty = 0
addNums (Node n []) = n
addNums (Node n (x:xs)) = n + (addNums x) + addNums (Node 0 xs)

@user3237465 说：

data Tree a = Empty | Node a [Tree a] deriving (Eq, Show, Foldable)

myNums :: (Num a) => Tree a
myNums = ...

main = print $ sum myNums

和@chi 说：

addNums :: (Num a) => Tree a -> a
addNums Empty = 0
addNums (Node n xs) = n + sum (map addNums xs)

如何找到最有效的解决方案？ Haskell 中有本地基准测试工具吗？

Answer 1

虽然 so.com 不是推荐网站，但我建议您查看标准 https://hackage.haskell.org/package/criterion

明天我可能会给出一些它的用法示例

如果你真的想深入研究这个问题，你可以通过添加编译器选项 --ddump-llvm 来分析生成的 llvm 汇编器，尽管这是一个相当高级的主题，只是为了完整起见才包括在内。

更新 - 在这种情况下如何使用 criterion

首先我将使用haskell堆栈工具来解释这一点，所有代码都可以在github/epsilonhalbe找到

首先，我们创建一个项目并将每个相关定义拆分到一个单独的模块中（否则我们将需要data Tree、data Tree' 和data Tree''）。以Chi.hs为例：

module Chi where

data Tree a = Empty | Node a [Tree a] deriving (Eq, Show)

addNums :: (Num a) => Tree a -> a
addNums Empty = 0
addNums (Node n xs) = n + sum (map addNums xs)

myInts :: Tree Int
myInts =
    Node 1 [
           Node 2 [
             Node 4 [Empty], Node 5 [Empty]
           ],
           Node 3 [
             Node 6 [Empty], Node 7 [Empty], Node 8 [Empty]
           ]
        ]

myDouble :: Tree Double
myDouble =
    Node 1 [
           Node 2 [
             Node 4 [Empty], Node 5 [Empty]
           ],
           Node 3 [
             Node 6 [Empty], Node 7 [Empty], Node 8 [Empty]
           ]
        ]

注意：对于User3237465.hs，我们需要一个语言编译指示

{-# LANGUAGE DeriveFoldable #-}
module User3237465 where

data Tree a = Empty | Node a [Tree a] deriving (Eq, Show, Foldable)

addNums :: Num a => Tree a -> a
addNums = sum

myInts ..
myDouble ..

我们构建一个如下所示的文件夹/文件结构（这是我们通过stack new critExample 和一些复制/重命名/删除得到的）

../haskell/critExample/
▾ src/
    Chi.hs
    Sibi.hs
    User3237465.hs
▾ bench/
    Benchmarks.hs
  critExample.cabal
  LICENSE
  Setup.hs
  stack.yaml

critExample.cabal的内容也需要调整一下，

name:                critExample
[... non-important stuff ...]

library
  hs-source-dirs:      src
  -- don't forget to adjust the exposed modules
  exposed-modules:     Chi
                 ,     Sibi
                 ,     User3237465
  build-depends:       base >= 4.7 && < 5
  default-language:    Haskell2010

-- and add the following benchmark part
benchmark addNums
  type:                exitcode-stdio-1.0
  hs-source-dirs:      bench
  main-is:             Benchmarks.hs
  build-depends:       base
                     , critExample
                     , criterion
  default-language:    Haskell2010
  [...]

然后我们可以开始编写我们的基准测试

Benchmarks.hs

module Main where

import Criterion
import Criterion.Main

import qualified Chi
import qualified Sibi
import qualified User3237465


main :: IO ()
main = defaultMain [
    bgroup "myInts" [ bench "Sibi"        $ whnf Sibi.addNums Sibi.myInts
                    , bench "Chi"         $ whnf Chi.addNums Chi.myInts
                    , bench "User3237465" $ whnf User3237465.addNums User3237465.myInts
                    ],

    bgroup "myDouble" [ bench "Sibi"        $ whnf Sibi.addNums Sibi.myDouble
                      , bench "Chi"         $ whnf Chi.addNums Chi.myDouble
                      , bench "User3237465" $ whnf User3237465.addNums User3237465.myDouble ]
    ]

请注意，whnf 仅计算为 弱头范式，即它看到的第一个构造函数 - 对于列表，当它看到 (:) 运算符时，这将在第一个元素之后tuples 它不会评估任何东西，但对于 Int 或 Double 它会完全评估东西。如果您需要“深度”评估，请使用 nf 而不是 whnf - 如果您不确定需要什么，请同时尝试 whnf 通常快得不合理（例如超长列表的纳秒级 - 因为它只检查头部该列表中的）。

您可以使用stack build 构建项目，然后使用stack bench（触发所有可用的基准测试）或stack bench critExample:addNums（如果您有多个基准测试套件并且只想运行一个特定的套件，这很有用） ，用法始终为projectname:name of benchmarks given in cabal-file。

如果你想要花哨的 html 输出（相信我你想要它，因为 bryan o'sullivan 付出了很多努力让它变得性感），你必须：

./.stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/addNums/addNums --output index.html

当然，如果您不使用 linux 操作系统，此路径可能会有所不同。

更新2

基准测试的结果 - 我不知道它们的代表性 - 我在虚拟化 linux 中运行它们！

Running 1 benchmarks...
Benchmark addNums: RUNNING...
benchmarking myInts/Sibi
time                 616.7 ns   (614.1 ns .. 619.2 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 619.1 ns   (615.4 ns .. 626.8 ns)
std dev              17.09 ns   (9.625 ns .. 31.62 ns)
variance introduced by outliers: 38% (moderately inflated)

benchmarking myInts/Chi
time                 582.6 ns   (576.5 ns .. 592.1 ns)
                     0.998 R²   (0.996 R² .. 1.000 R²)
mean                 586.2 ns   (581.5 ns .. 595.5 ns)
std dev              21.14 ns   (11.56 ns .. 33.61 ns)
variance introduced by outliers: 52% (severely inflated)

benchmarking myInts/User3237465
time                 606.5 ns   (604.9 ns .. 608.2 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 607.0 ns   (605.5 ns .. 609.2 ns)
std dev              5.915 ns   (3.992 ns .. 9.798 ns)

benchmarking myInts/User3237465 -- folding variant see comments
time                 371.0 ns   (370.2 ns .. 371.7 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 372.5 ns   (370.8 ns .. 375.0 ns)
std dev              6.824 ns   (4.076 ns .. 11.19 ns)
variance introduced by outliers: 22% (moderately inflated)

benchmarking myDouble/Sibi
time                 678.9 ns   (642.3 ns .. 743.8 ns)
                     0.978 R²   (0.958 R² .. 1.000 R²)
mean                 649.9 ns   (641.1 ns .. 681.6 ns)
std dev              50.99 ns   (12.60 ns .. 105.0 ns)
variance introduced by outliers: 84% (severely inflated)

benchmarking myDouble/Chi
time                 643.3 ns   (617.4 ns .. 673.6 ns)
                     0.987 R²   (0.979 R² .. 0.996 R²)
mean                 640.6 ns   (626.7 ns .. 665.6 ns)
std dev              58.35 ns   (40.63 ns .. 87.82 ns)
variance introduced by outliers: 88% (severely inflated)

benchmarking myDouble/User3237465
time                 630.4 ns   (622.9 ns .. 638.5 ns)
                     0.997 R²   (0.994 R² .. 0.999 R²)
mean                 637.8 ns   (625.4 ns .. 659.8 ns)
std dev              53.15 ns   (33.46 ns .. 78.36 ns)
variance introduced by outliers: 85% (severely inflated)

benchmarking myDouble/User3237465 -- folding variant see comments
time                 398.1 ns   (380.7 ns .. 422.0 ns)
                     0.988 R²   (0.980 R² .. 0.996 R²)
mean                 400.6 ns   (389.1 ns .. 428.6 ns)
std dev              55.83 ns   (28.94 ns .. 103.6 ns)
variance introduced by outliers: 94% (severely inflated)

Benchmark addNums: FINISH
Completed all 2 actions.

如 cmets 中所述 - 使用 import Data.Foldable (foldl') 和 addNums' = foldl' (+) 0 的另一个变体明显更快（感谢@User3237465！！）

Answer 2

其实，为了提高效率，改变你的类型。出于折叠目的，您无法击败 Church Like Encoding。我可以推荐：

newtype Tree a = Tree {fold :: forall r. r -> (a -> [r] -> r) -> r}

甚至：

newtype Tree a = Tree {fold :: forall r. r -> (a -> ChurchList r -> r) -> r}

或者最好的：

newtype Tree a = Tree {fold :: forall tree list. tree -> (a -> list -> tree) -> list -> (tree -> list -> list) -> tree}

Church 编码效率更高，因为您不必遍历任何内容。