Haskell 应对 3n+1 挑战的方法

Question

这是一个来自 SPOJ 的简单编程问题：http://www.spoj.com/problems/PROBTRES/。

基本上，您被要求为 i 和 j 之间的数字输出最大的 Collat​​z 循环。 （数字 $n$ 的 Collat​​z 循环是最终从 $n$ 到 1 的步数。）

我一直在寻找一种 Haskell 方法来解决与 Java 或 C++ 相比性能比较的问题（以适应允许的运行时限制）。尽管一个简单的 Java 解决方案可以记住任何已计算的周期的周期长度。我没有成功地应用这个想法来获得 Haskell 解决方案。

我已经尝试了 Data.Function.Memoize，以及使用这篇文章中的想法的自制日志时间记忆技术：Memoization in Haskell?。不幸的是，记忆化实际上使 cycle(n) 的计算更慢。我相信减速来自haskell方式的开销。 （我尝试使用编译后的二进制代码运行，而不是解释。）

我还怀疑，简单地将数字从 i 迭代到 j 可能代价高昂 ($i,j\le10^6$)。所以我什至尝试使用来自http://blog.openendings.net/2013/10/range-trees-and-profiling-in-haskell.html 的想法预先计算范围查询的所有内容。但是，这仍然会出现“超出时间限制”错误。

您能否为此提供一个整洁的、有竞争力的 Haskell 程序？

谢谢！

Answer 1

>>> 使用下面的方法，我可以submit an accepted answer to SPOJ。你可以从here查看整个代码。

---

问题有界限0 < n < 1,000,000。预先计算 all 并将它们存储在一个数组中；然后冻结数组。该数组可以用作自己的缓存/记忆空间。

然后问题将简化为数组上的范围查询问题，这可以使用树非常有效地完成。

使用下面的代码，我可以在几分之一秒内获得 1..1,000,000 的 Collat​​z：

$ time echo 1000000 | ./collatz 
525

real    0m0.177s
user    0m0.173s
sys     0m0.003s

注意下面的collatz函数，内部使用了可变的STUArray，但它本身是一个纯函数：

import Control.Monad.ST (ST)
import Control.Monad (mapM_)
import Control.Applicative ((<$>))
import Data.Array.Unboxed (UArray, elems)
import Data.Array.ST (STUArray, readArray, writeArray, runSTUArray, newArray)

collatz :: Int -> UArray Int Int
collatz size = out
    where
    next i = if odd i then 3 * i + 1 else i `div` 2

    loop :: STUArray s Int Int -> Int -> ST s Int
    loop arr k
        | size < k  = succ <$> loop arr (next k)
        | otherwise = do
            out <- readArray arr k
            if out /= 0 then return out
            else do
                out <- succ <$> loop arr (next k)
                writeArray arr k out
                return out

    out = runSTUArray $ do
        arr <- newArray (1, size) 0
        writeArray arr 1 1
        mapM_ (loop arr) [2..size]
        return arr

main = do
    size <- read <$> getLine
    print . maximum . elems $ collatz size

为了对该数组执行范围查询，您可以构建一个平衡树，如下所示：

type Range = (Int, Int)
data Tree  = Leaf Int | Node Tree Tree Range Int

build_tree :: Int -> Tree
build_tree size = loop 1 cnt
    where
    ctz = collatz size
    cnt = head . dropWhile (< size) $ iterate (*2) 1

    (Leaf a)       +: (Leaf b)       = max a b
    (Node _ _ _ a) +: (Node _ _ _ b) = max a b

    loop lo hi
        | lo == hi  = Leaf $ if size < lo then minBound else ctz ! lo
        | otherwise = Node left right (lo, hi) (left +: right)
        where
        i = (lo + hi) `div` 2
        left  = loop lo i
        right = loop (i + 1) hi

query_tree :: Tree -> Int -> Int -> Int
query_tree (Leaf x) _ _ = x
query_tree (Node l r (lo, hi) x) i j
    | i <= lo && hi <= j = x
    | mid < i       = query_tree r i j
    | j   < 1 + mid = query_tree l i j
    | otherwise     = max (query_tree l i j) (query_tree r i j)
    where mid = (lo + hi) `div` 2

Answer 2

这里与另一个答案相同，但使用了一个不可变的递归定义数组（而且它也有轻微泄漏（有人能说为什么吗？）所以慢了两倍）：

import Data.Array

upper = 10^6

step :: Integer -> Int
step i = 1 + colAt (if odd i then 3 * i + 1 else i `div` 2)

colAt :: Integer -> Int
colAt i | i > upper = step i
colAt i = col!i

col :: Array Integer Int
col = array (1, upper) $ (1, 1) : [(i, step i) | i <- [2..upper]]

main = print $ maximum $ elems col