6

我目前正在尝试优化我对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 是尾递归的吗？如果不是，我怎么能做到这一点？

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

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

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

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

4

2 回答 2

20

好吧，让我们从顶部开始。首先重要的是给出你用来编译和运行的确切命令行；对于我的回答，我将使用这一行来计算所有程序的时间：

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 不会自动并行化或记忆您的程序。这两件事的开销都很难估计，因此很难决定什么时候做它们会是有益的。我有不知道为什么这个答案中的串行解决方案的 CPU 利用率也超过 100%；也许一些垃圾收集正在另一个线程或类似的事情中发生。）我们将从 开始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

下一个提升来自使用比evenand更快的操作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与记忆的C版本竞争）

于 2012-08-15T02:43:09.227 回答
0

GHC 不会自动为您并行化任何内容。正如你猜测的那样，get_sequence_length它不是尾递归的。见这里。并考虑编译器（除非它为您做了一些很好的优化）如何在您完成之前无法评估所有这些递归加法；您正在“建立 thunk”，这通常不是一件好事。

尝试调用递归辅助函数并传递一个累加器，或者尝试根据foldr.

于 2012-08-15T01:08:57.513 回答