Question

我目前正在尝试在Projet Euler上优化我的解决方案problem 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明确地完成？

编辑：我偶然发现了this类似的问题。他们提到他的功能不是尾递归的。我的get_sequence_length尾部是递归的吗？如果不是我怎么能这样做？

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

我在Windws 7（64位），3.3 GHZ Quad内核和8GB RAM上运行测试。
我做的第一件事就是你说用Int替换所有的Integer，但每当我运行任何主电源时，我的内存耗尽，即使+ RTS kSize -RTS设置得非常高。

最终我发现this（stackoverflow非常棒......），这意味着由于Windows上的所有Haskell程序都以32位运行，因此Ints溢出导致无限递归，只是哇...... / p>

我在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更改为{{ 1}}，因为前者只是意外地计算出正确的答案。 =）

我现在将重点关注串行速度。（回答你的一个直接问题：不，GHC不会自动并行化或记忆你的程序。这两个都有很难估计的开销，因此很难确定何时做这些是有益的。我有不知道为什么即使这个答案中的串行解决方案获得了> 100％的CPU利用率;也许一些垃圾收集正在另一个线程或某些事情中发生。）我们将从maximumBy (comparing length) [s1, s2]开始，因为它更快两个串行实现。最简单的方法是将所有类型的签名从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快约17倍 - 转换为C时的竞争性改进。

对于记忆，有几个选择。最简单的方法是使用预先存在的包（如data-memocombinators）来创建不可变数组并从中读取。时序对于为这个阵列选择合适的尺寸非常敏感;对于这个问题，我发现main2是一个相当不错的上限。

这样：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（与备忘的C版竞争）

Answer 2

GHC不会自动并行化任何内容。正如你猜测get_sequence_length不是尾递归的。见here。并考虑编译器（除非它为你做一些很好的优化）不能评估所有那些递归添加，直到你到达结尾;你正在“建立阵雨”，这通常不是一件好事。

尝试调用递归辅助函数并传递累加器，或尝试用foldr来定义它。

Haskell中的缓存和显式并行性

2 个答案: