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 Quad内核和8GB RAM上运行测试.
我做的第一件事就是你说用Int替换所有的Integer,但每当我运行任何主电源时我的内存耗尽,即使+ 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来提高竞争力.

对于记忆,有几个选择.最简单的方法是使用像data-memocombinators这样的预先存在的包来创建不可变数组并从中读取.时序对于为这个阵列选择合适的尺寸非常敏感; 对于这个问题,我发现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与memoized C版本竞争)