阿克曼用Haskell/GHC非常低效

Question

我尝试计算 Ackermann(4,1) ，不同语言/编译器之间的性能差异很大。以下是我在Core i7 3820QM, 16G, Ubuntu 12.10 64bit， ，

上的结果

C: 1.6 s , gcc -O3 (gcc 4.7.2)

int ack(int m, int n) {
  if (m == 0) return n+1;
  if (n == 0) return ack(m-1, 1);
  return ack(m-1, ack(m, n-1));
}
int main() {
  printf("%dn", ack(4,1));
  return 0;
}

OCaml: 3.6 s , ocamlopt (OCaml 3.12.1)

let rec ack = function
  | 0,n -> n+1
  | m,0 -> ack (m-1, 1)
  | m,n -> ack (m-1, ack (m, n-1))
in print_int (ack (4, 1))

标准ML: 5.1s mlton -codegen c -cc-opt -O3 (with mlton 20100608)

fun ack 0 n = n+1
  | ack m 0 = ack (m-1) 1
  | ack m n = ack (m-1) (ack m (n-1));
print (Int.toString (ack 4 1));

球拍:11.5 s racket (球拍v5.3.3)

(require racket/unsafe/ops)
(define + unsafe-fx+)
(define - unsafe-fx-)
(define (ack m n)
  (cond
    [(zero? m) (+ n 1)]
    [(zero? n) (ack (- m 1) 1)]
    [else (ack (- m 1) (ack m (- n 1)))]))
(time (ack 4 1))

Haskell: unfinished，在22秒后被系统杀死ghc -O2 (使用ghc 7.4.2)

Haskell: 1.8 s ajhc (ajhc 0.8.0.4)

main = print $ ack 4 1
  where ack :: Int -> Int -> Int
        ack 0 n = n+1
        ack m 0 = ack (m-1) 1
        ack m n = ack (m-1) (ack m (n-1))

Haskell版本是唯一一个不能正确终止的版本，因为它占用了太多内存。它会冻结我的机器，并在被杀死之前填满交换空间。在不严重篡改代码的情况下，我能做些什么来改进它?

EDIT:我欣赏一些渐进的更聪明的解决方案，但它们并不是我所要求的。与计算ackermann函数相比，这更多地是为了查看编译器是否以合理有效的方式处理某些模式(堆栈、尾部调用、拆箱等)。

EDIT 2:正如几个响应所指出的，这似乎是GHC最近版本中的一个错误。我用AJHC尝试了相同的代码，并获得了更好的性能。

非常感谢:)

Answer 1

NB:高内存使用问题是GHC RTS中的一个错误，在堆栈溢出和堆上新堆栈的分配时，没有检查垃圾收集是否到期。这已经在GHC HEAD中修复了。

---

我能够通过cps转换ack:

获得更好的性能

module Main where
data P = P !Int !Int
main :: IO ()
main = print $ ack (P 4 1) id
  where
    ack :: P -> (Int -> Int) -> Int
    ack (P 0 n) k = k (n + 1)
    ack (P m 0) k = ack (P (m-1) 1) k
    ack (P m n) k = ack (P m (n-1)) (a -> ack (P (m-1) a) k)

你原来的函数消耗了我机器上所有可用的内存，而这个函数在恒定的空间中运行。

$ time ./Test
65533
./Test  52,47s user 0,50s system 96% cpu 54,797 total

Ocaml仍然更快，但是:

$ time ./test
65533./test  7,97s user 0,05s system 94% cpu 8,475 total

Edit:当使用JHC编译时，您的原始程序与Ocaml版本一样快:

$ time ./hs.out 
65533
./hs.out  5,31s user 0,03s system 96% cpu 5,515 total

Edit 2:我还发现:使用更大的堆栈块大小(+RTS -kc1M)运行原始程序使其在恒定空间中运行。不过，CPS版本还是快一些。

编辑3:通过手动展开主循环，我设法生成了一个运行速度几乎和Ocaml一样快的版本。然而，它只在+RTS -kc1M下运行时有效(Dan Doel已经提交了一个关于此行为的错误):

{-# LANGUAGE CPP #-}
module Main where
data P = P {-# UNPACK #-} !Int {-# UNPACK #-} !Int
ack0 :: Int -> Int
ack0 n =(n+1)
#define C(a) a
#define CONCAT(a,b) C(a)C(b)
#define AckType(M) CONCAT(ack,M) :: Int -> Int
AckType(1)
AckType(2)
AckType(3)
AckType(4)
#define AckDecl(M,M1) 
CONCAT(ack,M) n = case n of { 0 -> CONCAT(ack,M1) 1 
; 1 ->  CONCAT(ack,M1) (CONCAT(ack,M1) 1) 
; _ ->  CONCAT(ack,M1) (CONCAT(ack,M) (n-1)) }
AckDecl(1,0)
AckDecl(2,1)
AckDecl(3,2)
AckDecl(4,3)
ack :: P -> (Int -> Int) -> Int
ack (P m n) k = case m of
  0 -> k (ack0 n)
  1 -> k (ack1 n)
  2 -> k (ack2 n)
  3 -> k (ack3 n)
  4 -> k (ack4 n)
  _ -> case n of
    0 -> ack (P (m-1) 1) k
    1 -> ack (P (m-1) 1) (a -> ack (P (m-1) a) k)
    _ -> ack (P m (n-1)) (a -> ack (P (m-1) a) k)
main :: IO ()
main = print $ ack (P 4 1) id

测试:

$ time ./Test +RTS -kc1M
65533
./Test +RTS -kc1M  6,30s user 0,04s system 97% cpu 6,516 total

Edit 4:显然，空间泄漏在GHC HEAD中是固定的，因此将来不需要+RTS -kc1M。

Answer 2

似乎涉及到某种bug。你使用的是什么版本的GHC ?

使用GHC 7，我得到与您相同的行为。程序消耗所有可用内存而不产生任何输出。

然而，如果我用GHC 6.12.1与ghc --make -O2 Ack.hs编译它，它可以完美地工作。它在10.8s中计算结果，而普通C版本需要7.8s。

我建议你在GHC网站上报告这个bug。

Answer 3

这个版本使用了ackermann函数的一些属性。它不等于其他版本，但速度很快:

ackermann :: Int -> Int -> Int
ackermann 0 n = n + 1
ackermann m 0 = ackermann (m - 1) 1
ackermann 1 n = n + 2
ackermann 2 n = 2 * n + 3
ackermann 3 n = 2 ^ (n + 3) - 3
ackermann m n = ackermann (m - 1) (ackermann m (n - 1))

编辑:这是一个有记忆的版本，我们看到在haskell中很容易记忆一个函数，唯一的变化是在调用点:

import Data.Function.Memoize
ackermann :: Integer -> Integer -> Integer
ackermann 0 n = n + 1
ackermann m 0 = ackermann (m - 1) 1
ackermann 1 n = n + 2
ackermann 2 n = 2 * n + 3
ackermann 3 n = 2 ^ (n + 3) - 3
ackermann m n = ackermann (m - 1) (ackermann m (n - 1))
main :: IO ()
main = print $ memoize2 ackermann 4 2

Answer 4

下面是一个习惯的版本，它利用了Haskell的惰性和GHC对常量顶级表达式的优化。

acks :: [[Int]]
acks = [ [ case (m, n) of
                (0, _) -> n + 1
                (_, 0) -> acks !! (m - 1) !! 1
                (_, _) -> acks !! (m - 1) !! (acks !! m !! (n - 1))
         | n <- [0..] ]
       | m <- [0..] ]
main :: IO ()
main = print $ acks !! 4 !! 1

在这里，我们正在为所有 Ackermann函数的值建立一个矩阵。因此，对acks的后续调用不会重新计算任何内容(即再次计算acks !! 4 !! 1将而不是使运行时间加倍)。

虽然这不是最快的解决方案，但它看起来很像naïve的实现，它在内存使用方面非常有效，并且它将Haskell的一个奇怪的特性(懒惰)重新定义为优点。

Answer 5

我根本不认为这是一个bug, ghc只是没有利用这样一个事实，即它知道4和1是函数将被调用的唯一参数——也就是说，说白了，它不会作弊。它也不会为你做恒定的数学运算，所以如果你写的是main = print $ ack (2+2) 1，直到运行时它才会计算出2+2 = 4。ghc有更重要的事情要考虑。后一种困难的帮助是可用的，如果你关心它http://hackage.haskell.org/package/const-math-ghc-plugin。

所以ghc是有帮助的，如果你做一点数学计算，例如，这至少是你的C程序的100倍，以4和1为参数。但是试试4 &2:

main = print $ ack 4 2 where
    ack :: Int -> Integer -> Integer
    ack 0 n = n + 1
    ack 1 n = n + 2 
    ack 2 n = 2 * n + 3
    ack m 0 = ack (m-1) 1
    ack m n = ack (m-1) (ack m (n-1) )

这将在不到十分之一秒的时间内给出正确的答案，所有的~20,000位数字，而使用您的算法的gcc将永远无法给出错误的答案。

Answer 6

在Haskell中编写算法的方式与在C中编写算法的方式相似，但这并不是同一种算法，因为递归的语义是完全不同的。

这是一个使用相同数学算法的版本，但我们使用数据类型象征性地表示对Ackermann函数的调用。这样，我们可以更精确地控制递归的语义。

当使用优化编译时，这个版本在固定内存中运行，但是速度很慢——在类似于您的环境中大约需要4.5分钟。但我相信它可以被修改得更快。这只是给一个想法。

data Ack = Ack !Int
ack :: Int -> Int -> Int
ack m n = length . ackR $ Ack m : replicate n (Ack 0)
  where
    ackR n@(Ack 0 : _) = n
    ackR n             = ackR $ ack' n
    ack' [] = []
    ack' (Ack 0 : n) = Ack 0 : ack' n
    ack' [Ack m]     = [Ack (m-1), Ack 0]
    ack' (Ack m : n) = Ack (m-1) : ack' (Ack m : decr n)
    decr (Ack 0 : n) = n
    decr n           = decr $ ack' n

Answer 7

这个性能问题(除了GHC RTS bug明显)似乎在苹果XCode更新到4.6.2后，现在在OS X 10.8上得到了修复。我仍然可以在Linux上复制它(虽然我一直在测试GHC LLVM后端)，但在OS x上不再有了。在我将XCode更新到4.6.2之后，新版本似乎已经影响了GHC后端代码生成Ackermann基本上(从我记得的对象转储更新前)。在XCode更新之前，我在Mac上重现了这个性能问题——我没有具体数据，但肯定非常糟糕。所以，XCode更新似乎改善了Ackermann的GHC代码生成。

现在，C和GHC版本都非常接近。C代码:

int ack(int m,int n){
  if(m==0) return n+1;
  if(n==0) return ack(m-1,1);
  return ack(m-1, ack(m,n-1));
}

执行ack(4,1)的时间:

GCC 4.8.0: 2.94s
Clang 4.1: 4s

Haskell代码:

ack :: Int -> Int -> Int
ack 0 n = n+1
ack m 0 = ack (m-1) 1
ack m n = ack (m-1) (ack m (n-1))

执行ack 4 1的时间(使用+RTS -kc1M):

GHC 7.6.1 Native: 3.191s
GHC 7.6.1 LLVM: 3.8s 

所有的编译用-O2标志(和-rtsopts标志的GHC RTS bug解决方案)。这是一个相当令人头疼的问题。更新XCode似乎对GHC中Ackermann的优化产生了很大的影响。