Haskell中的缓存和显式并行性

Question

我目前正在尝试优化Projet Euler问题14的解决方案。我真的很喜欢Haskell，我认为它非常适合这类问题，这是我尝试过的三种不同的解决方案：

import Data.List (unfoldr, maximumBy)
import Data.Maybe (fromJust, isNothing)
import Data.Ord (comparing)
import Control.Parallel
next :: Integer -> Maybe (Integer)
next 1 = Nothing
next n
  | even n = Just (div n 2)
  | odd n  = Just (3 * n + 1)
get_sequence :: Integer -> [Integer]
get_sequence n = n : unfoldr (pack . next) n
  where pack n = if isNothing n then Nothing else Just (fromJust n, fromJust n)
get_sequence_length :: Integer -> Integer
get_sequence_length n
    | isNothing (next n) = 1
    | otherwise = 1 + (get_sequence_length $ fromJust (next n))
-- 8 seconds
main1 = print $ maximumBy (comparing length) $ map get_sequence [1..1000000]
-- 5 seconds
main2 = print $ maximum $ map (n -> (get_sequence_length n, n)) [1..1000000]
-- Never finishes
main3 = print solution
  where
    s1 = maximumBy (comparing length) $ map get_sequence [1..500000]
    s2 = maximumBy (comparing length) $ map get_sequence [500001..10000000]
    solution = (s1 `par` s2) `pseq` max s1 s2

现在，如果您查看实际问题，就会发现缓存的潜力很大，因为大多数新序列将包含之前已经计算过的子序列。

为了比较，我也用 C 写了一个版本：
带缓存的运行时间：0.03 秒
无缓存的运行时间：0.3 秒

这简直太疯狂了！当然，缓存将时间减少了 10 倍，但即使没有缓存，它仍然比我的 Haskell 代码快至少 17 倍。

我的代码有什么问题？为什么 Haskell 不为我缓存函数调用？由于函数是纯缓存，缓存不应该是微不足道的，只是可用内存的问题吗？

我的第三个并行版本有什么问题？为什么它没有完成？

关于Haskell作为一种语言，编译器是否会自动并行化某些代码（折叠，映射等），还是总是必须使用Control.Parallel显式完成？

编辑：我偶然发现了这个类似的问题。他们提到他的函数不是尾递归的。我的get_sequence_length尾递归吗？如果不是，我怎么能做到呢？

编辑2：
致丹尼尔：
非常感谢您的回复，真的很棒。我一直在玩你的改进，我发现了一些非常糟糕的陷阱。

我正在 Windws 7（64 位）、3.3 GHZ 四核和 8GB RAM 上运行测试。
我做的第一件事就是如您所说将所有整数替换为 Int，但是每当我运行任何电源时，我的内存就会耗尽，即使 +RTS kSize -RTS 设置得高得离谱。

最终我发现了这个（stackoverflow很棒......），这意味着由于Windows上的所有Haskell程序都以32位运行，Ints溢出导致无限递归，只是哇......

我在 Linux 虚拟机（使用 64 位 ghc）中运行了测试，并得到了类似的结果。

Answer 1

好吧，让我们从顶部开始。首先重要的是提供您用于编译和运行的确切命令行;对于我的答案，我将使用此行作为所有程序的计时：

ghc -O2 -threaded -rtsopts test && time ./test +RTS -N

接下来：由于机器之间的时序差异很大，我们将为我的机器和您的程序提供一些基线时序。这是我计算机的uname -a输出：

Linux sorghum 3.4.4-2-ARCH #1 SMP PREEMPT Sun Jun 24 18:59:47 CEST 2012 x86_64 Intel(R) Core(TM)2 Quad CPU Q6600 @ 2.40GHz GenuineIntel GNU/Linux

亮点是：四核，2.4GHz，64位。

使用main1：30.42s user 2.61s system 149% cpu 22.025 total
使用main2：21.42s user 1.18s system 129% cpu 17.416 total
使用main3：22.71s user 2.02s system 220% cpu 11.237 total

实际上，我以两种方式修改了main3：首先，从 s2 的范围末尾删除其中一个零，其次，将max s1 s2更改为 maximumBy (comparing length) [s1, s2] ，因为前者只是意外地计算出正确答案。 =）

我现在将重点介绍串行速度。（回答您的一个直接问题：不，GHC 不会自动并行化或记忆您的程序。这两件事都有很难估计的开销，因此很难决定何时做它们是有益的。我不知道为什么即使是这个答案中的串行解决方案也能获得>100% 的 CPU 利用率;也许在另一个线程或类似的事情中发生了一些垃圾收集。我们将从 main2 开始，因为它是两个串行实现中更快的。获得一点提升的最便宜方法是将所有类型签名从 Integer 更改为 Int：

使用Int：11.17s user 0.50s system 129% cpu 8.986 total（大约两倍快）

下一个提升来自减少内部循环中的分配（消除中间Maybe值）。

import Data.List
import Data.Ord
get_sequence_length :: Int -> Int
get_sequence_length 1 = 1
get_sequence_length n
    | even n = 1 + get_sequence_length (n `div` 2)
    | odd  n = 1 + get_sequence_length (3 * n + 1)
lengths :: [(Int,Int)]
lengths = map (n -> (get_sequence_length n, n)) [1..1000000]
main = print (maximumBy (comparing fst) lengths)

使用这个： 4.84s user 0.03s system 101% cpu 4.777 total

下一个提升来自使用比even和div更快的操作：

import Data.Bits
import Data.List
import Data.Ord
even' n = n .&. 1 == 0
get_sequence_length :: Int -> Int
get_sequence_length 1 = 1
get_sequence_length n = 1 + get_sequence_length next where
    next = if even' n then n `quot` 2 else 3 * n + 1
lengths :: [(Int,Int)]
lengths = map (n -> (get_sequence_length n, n)) [1..1000000]
main = print (maximumBy (comparing fst) lengths)

使用这个： 1.27s user 0.03s system 105% cpu 1.232 total

对于那些在家里跟随的人来说，这比我们开始的main2快了大约 17 倍——切换到 C 的竞争性改进。

对于记忆，有几个选择。最简单的方法是使用预先存在的包（如数据记忆组合器）创建一个不可变的数组并从中读取。时序对于为此数组选择合适的大小相当敏感;对于这个问题，我发现50000是一个相当不错的上限。

import Data.Bits
import Data.MemoCombinators
import Data.List
import Data.Ord
even' n = n .&. 1 == 0
pre_length :: (Int -> Int) -> (Int -> Int)
pre_length f 1 = 1
pre_length f n = 1 + f next where
    next = if even' n then n `quot` 2 else 3 * n + 1
get_sequence_length :: Int -> Int
get_sequence_length = arrayRange (1,50000) (pre_length get_sequence_length)
lengths :: [(Int,Int)]
lengths = map (n -> (get_sequence_length n, n)) [1..1000000]
main = print (maximumBy (comparing fst) lengths)

有了这个：0.53s user 0.10s system 149% cpu 0.421 total

最快的方法是使用可变的、未装箱的数组作为记忆位。它不那么惯用，但它是裸机速度。速度对这个数组的大小不那么敏感，只要数组的大小和你想要答案的最大的东西一样大。

import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Bits
import Data.List
import Data.Ord
even' n = n .&. 1 == 0
next  n = if even' n then n `quot` 2 else 3 * n + 1
get_sequence_length :: STUArray s Int Int -> Int -> ST s Int
get_sequence_length arr n = do
    bounds@(lo,hi) <- getBounds arr
    if not (inRange bounds n) then (+1) `fmap` get_sequence_length arr (next n) else do
        let ix = n-lo
        v <- unsafeRead arr ix
        if v > 0 then return v else do
            v' <- get_sequence_length arr (next n)
            unsafeWrite arr ix (v'+1)
            return (v'+1)
maxLength :: (Int,Int)
maxLength = runST $ do
    arr <- newArray (1,1000000) 0
    writeArray arr 1 1
    loop arr 1 1 1000000
    where
    loop arr n len 1  = return (n,len)
    loop arr n len n' = do
        len' <- get_sequence_length arr n'
        if len' > len then loop arr n' len' (n'-1) else loop arr n len (n'-1)
main = print maxLength

有了这个：0.16s user 0.02s system 138% cpu 0.130 total（与记忆的C版本竞争）

Answer 2

> GHC 不会自动为您并行化任何内容。正如你所猜测的get_sequence_length不是尾递归的。看这里。并考虑编译器（除非它为你做了一些很好的优化）如何在你到达最后之前无法评估所有这些递归添加;你正在"建立笨蛋"，这通常不是一件好事。

尝试

调用递归帮助程序函数并传递累加器，或者尝试根据foldr定义它。