GHC 优化：Collatz 猜想

Question

GHC 优化：Collatz 猜想

haskelloptimization

12

我写了一个针对Project Euler挑战14的代码，分别使用Haskell和C++编写（ideone链接）。它们都会在数组中记住之前做过的计算。

使用ghc -O2和g++ -O3编译后，C++版本比Haskell版本快10-15倍。

虽然我知道Haskell版本可能运行得比较慢，并且Haskell是一种更好的编程语言，但知道一些可以使Haskell版本运行更快的代码更改将会很不错（最好是能够达到C++版本的两三倍速度）？

Haskell代码如下：

import Data.Array
import Data.Word
import Data.List

collatz_array = 
  let
    upperbound = 1000000
    a = array (1, upperbound) [(i :: Word64, f i :: Int) | i <- [1..upperbound]]
    f i = i `seq`
      let
        check_f i = i `seq` if i <= upperbound then a ! i else f i
      in
        if (i == 1) then 0 else (check_f ((if (even i) then i else 3 * i + 1) `div` 2)) + 1
  in a

main = 
  putStrLn $ show $ 
   foldl1' (\(x1,x2) (y1,y2) -> if (x2 >= y2) then (x1, x2) else (y1, y2)) $! (assocs collatz_array)

编辑：

我现在还做了一个使用非装箱可变数组的版本。它仍然比C++版本慢5倍，但是有了显著的改进。代码可以在ideone上这里找到。

我想知道如何改进可变数组版本，使其更接近C++版本。

- Clinton

提醒一下，使用-fllvm编译可以在我的电脑上提高大约10%的性能。 - Greg E.

你的 seq 没有任何作用；你的两个函数都在 i 上是严格的。 GHC 曾经在 32 位平台上进行 64 位算术运算时表现非常糟糕，但我不知道你使用的是什么平台。 - augustss

1

这段程序相关的内容不解释你的性能问题，但是无论是你的C++（至少是Nanothief发布的）还是Haskell代码都没有得到正确的答案。我无法编译你的C++代码，但是我的纯Haskell解决方案与你的代码长度大致相同，在我的机器上快了约25％，并且产生了正确的结果。目前看起来，大约一半的时间似乎与启动Haskell程序有关的开销。 - Philip JF

@PhilipJF 代码产生的结果有多大程度上不正确？请注意，Clinton使用了稍微不同的步骤，即对于奇数n，他直接转到(3*n+1)/2，而不是采取两个步骤。因此，他得到了不同的链长度，但最长链的起始点是相同的。 - Daniel Fischer

@DanielFischer 没错，问题描述了链的长度，其中 (3n+1)/2 会使长度增加 2。他有正确的起点，但长度不对。 - Philip JF

@PhilipJF 但幸运的是，只需要起点。现在，证明计算链长度的两种方法总是产生与起点相同的值是一个不同的问题（例如，考虑7和44；但可能存在这样的对之间始于更长链的情况）。 - Daniel Fischer

2个回答

2

ideone网站使用的是ghc 6.8.2版本，这个版本已经比较老了。在ghc版本7.4.1上，差异要小得多。

使用ghc：

$ ghc -O2 euler14.hs && time ./euler14
(837799,329)
./euler14  0.63s user 0.04s system 98% cpu 0.685 total

使用g++ 4.7.0：

$ g++ --std=c++0x -O3 euler14.cpp && time ./a.out
8400511 429
./a.out  0.24s user 0.01s system 99% cpu 0.252 total

对我而言，GHC版本的速度只比C++版本慢了2.7倍。此外，这两个程序并没有给出相同的结果……（这对基准测试来说不是一个好兆头）

- David Miani

糟糕，我发布了一千万而不是一百万的测试。链接已经纠正。请注意，C++版本比Haskell版本快2.7倍，其处理一千万数据的速度相当于Haskell处理一百万数据的速度。 - Clinton

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Daniel Fischer · Accepted Answer

你的（可变数组）代码存在一些问题：

你使用fold函数来查找最大链长度，为此需要将数组转换为关联列表，这需要时间和分配C++版本不需要的空间。
你使用even和div测试分别除以2。这很慢。g ++将两个操作优化为更快的位操作（在那些被认为更快的平台上），但GHC尚未执行这些低级优化，因此暂时必须手动完成。
您使用readArray和writeArray。C ++代码中没有进行的额外边界检查也需要时间，在处理其他问题后，由于算法中进行了大量的读写操作，这占用了运行时间的相当部分（在我的盒子上约为25％）。

将其纳入实现后，我得到：

import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits

collatz_array :: ST s (STUArray s Int Int)
collatz_array = do
    let upper = 10000000
    arr <- newArray (0,upper) 0
    unsafeWrite arr 2 1
    let check i
            | upper < i = return arr
            | i .&. 1 == 0 = do
                l <- unsafeRead arr (i `shiftR` 1)
                unsafeWrite arr i (l+1)
                check (i+1)
            | otherwise = do
                let j = (3*i+1) `shiftR` 1
                    find k l
                        | upper < k = find (next k) $! l+1
                        | k < i     = do
                            m <- unsafeRead arr k
                            return (m+l)
                        | otherwise = do
                            m <- unsafeRead arr k
                            if m == 0
                              then do
                                  n <- find (next k) 1
                                  unsafeWrite arr k n
                                  return (n+l)
                              else return (m+l)
                          where
                            next h
                                | h .&. 1 == 0 = h `shiftR` 1
                                | otherwise = (3*h+1) `shiftR` 1
                l <- find j 1
                unsafeWrite arr i l
                check (i+1)
    check 3

collatz_max :: ST s (Int,Int)
collatz_max = do
    car <- collatz_array
    (_,upper) <- getBounds car
    let find w m i
            | upper < i = return (w,m)
            | otherwise = do
                l <- unsafeRead car i
                if m < l
                  then find i l (i+1)
                  else find w m (i+1)
    find 1 0 2

main :: IO ()
main = print (runST collatz_max)

以下是两个1千万级别的时间（单位为秒）：

$ time ./cccoll
8400511 429

real    0m0.210s
user    0m0.200s
sys     0m0.009s
$ time ./stcoll
(8400511,429)

real    0m0.341s
user    0m0.307s
sys     0m0.033s

看起来还不错。

重要提示：该代码仅适用于64位GHC（因此，在Windows上，您需要ghc-7.6.1或更高版本，以前的GHC即使在64位Windows上也是32位），因为中间链元素超出了32位范围。在32位系统上，必须使用 Integer 或64位整数类型（ Int64 或 Word64 ）来跟随链，这将极大地影响性能，因为在32位GHC中，原始的64位操作（算术和移位）被实现为对C函数的外部调用（快速的外部调用，但仍然比直接机器操作慢得多）。