haskell - 欧拉计划 14 : performance compared to C and memoization

Question

我目前正在处理 project euler problem 14 .

我使用一个编码不佳的程序解决了这个问题，没有内存，运行了 386 5 秒(见编辑)。

这里是:

step :: (Integer, Int) -> Integer -> (Integer, Int)
step (i, m) n   | nextValue > m         = (n, nextValue)
                | otherwise             = (i, m)
                where nextValue = syr n 1

syr :: Integer -> Int -> Int
syr 1 acc   = acc
syr x acc   | even x    = syr (x `div` 2) (acc + 1)
            | otherwise = syr (3 * x + 1) (acc + 1)

p14 = foldl step (0, 0) [500000..999999]

我的问题是关于与此问题相关的线程中的几条评论，其中提到了以下程序的执行时间 <1 s(C 代码，归功于项目 euler 论坛用户 ix 代码-注意:我没有检查执行时间是否确实如前所述):

#include <stdio.h>


int main(int argc, char **argv) {
    int longest = 0;
    int terms = 0;
    int i;
    unsigned long j;
    for (i = 1; i <= 1000000; i++) {
        j = i;
        int this_terms = 1;
        while (j != 1) {
            this_terms++;
            if (this_terms > terms) {
                terms = this_terms;
                longest = i;
            }
            if (j % 2 == 0) {
                j = j / 2;
            } else {
                j = 3 * j + 1;
            }
        }
    }
    printf("longest: %d (%d)\n", longest, terms);
    return 0;
}

对我来说，在谈论算法时，这些程序是一样的。

所以我想知道为什么会有这么大的差异？或者我们的两种算法之间是否有任何根本性的差异可以证明 x6 因素的性能？

顺便说一句，我目前正在尝试通过内存来实现这个算法，但对我来说有点迷茫，用命令式语言实现起来更容易(而且我还没有操作单子(monad)，所以我不能使用这个范例) .因此，如果您有任何适合初学者学习内存的好教程，我会很高兴(我遇到的那些不够详细或超出我的范围)。

注意:我是通过 Prolog 来到声明式范式的，现在还处于发现 Haskell 的早期过程中，所以我可能会错过重要的东西。

注意2:欢迎对我的代码提出任何一般性建议。

编辑:感谢 delnan 的帮助，我编译了程序，现在它在 5 秒内运行，所以我现在主要寻找关于内存的提示(即使仍然欢迎有关现有 x6 差距的想法)。

Answer 1

经过优化编译后，与 C 程序仍有一些不同之处

您使用 div ，而 C 程序使用机器除法(截断)[但任何自尊的 C 编译器都将其转换为移位，因此使其更快]，那将是 quot在 haskell ；这减少了大约 15% 的运行时间。

C 程序使用固定宽度的 64 位(甚至是 32 位，但得到正确答案只是运气，因为一些中间值超出 32 位范围)整数，Haskell 程序使用任意精度 Integer s。如果您有 64 位 Int s 在您的 GHC(Windows 以外的 64 位操作系统)中，替换 Integer与 Int .这将运行时间减少了大约 3 倍。如果您在 32 位系统上，那么您就不走运了，GHC 在那里不使用 native 64 位指令，这些操作是作为 C 调用实现的，这仍然很慢。

对于备忘录，您可以将其外包给 hackage 上的备忘录包之一，我记得唯一一个是 data-memocombinators ，但还有其他的。或者您也可以自己做，例如保留以前计算的值的映射 - 这在 State 中效果最好。单子(monad)，

import Control.Monad.State.Strict
import qualified Data.Map as Map
import Data.Map (Map, singleton)

type Memo = Map Integer Int

syr :: Integer -> State Memo Int
syr n = do
    mb <- gets (Map.lookup n)
    case mb of
      Just l -> return l
      Nothing -> do
          let m = if even n then n `quot` 2 else 3*n+1
          l <- syr m
          let l' = l+1
          modify (Map.insert n l')
          return l'

solve :: Integer -> Int -> Integer -> State Memo (Integer,Int)
solve maxi len start
    | len > 1000000 = return (maxi,len)
    | otherwise = do
         l <- syr start
         if len < l
             then solve start l (start+1)
             else solve maxi len (start+1)

p14 :: (Integer,Int)
p14 = evalState (solve 0 0 500000) (singleton 1 1)

但这可能不会获得太多(即使您添加了必要的严格性)。问题是在 Map 中的查找不太便宜，插入相对昂贵。

另一种方法是为查找保留一个可变数组。代码变得更加复杂，因为您必须为要缓存的值选择一个合理的上限(不应比起始值的上限大很多)并处理超出内存范围的序列部分。但是数组查找和写入速度很快。如果您有 64 位 Int s，下面的代码运行得非常快，这里它需要 0.03s 来限制 100 万，而 0.33s 来限制 1000 万，相应的(尽可能接近)C 代码分别以 0.018 运行。 0.2s。

module Main (main) where

import System.Environment (getArgs)
import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits
import Data.Int

main :: IO ()
main = do
    args <- getArgs
    let bd = case args of
               a:_ -> read a
               _   -> 100000
    print $ collMax bd

next :: Int -> Int
next n
    | n .&. 1 == 0  = n `unsafeShiftR` 1
    | otherwise     = 3*n + 1

collMax :: Int -> (Int,Int16)
collMax upper = runST $ do
    arr <- newArray (0,upper) 0 :: ST s (STUArray s Int Int16)
    let go l m
            | upper < m = go (l+1) $ next m
            | otherwise = do
                l' <- unsafeRead arr m
                case l' of
                  0 -> do
                      l'' <- go 1 $ next m
                      unsafeWrite arr m (l'' + 1)
                      return (l+l'')
                  _ -> return (l+l'-1)
        collect mi ml i
            | upper < i = return (mi, ml)
            | otherwise = do
                l <- go 1 i
                if l > ml
                  then collect i l (i+1)
                  else collect mi ml (i+1)
    unsafeWrite arr 1 1
    collect 1 1 2