欧拉计划 No. 14 Haskell答案

【问题标题】：Project Euler No. 14 Haskell欧拉计划 No. 14 Haskell
【发布时间】：2013-08-30 14:09:40
【问题描述】：

我正在尝试解决 Project Euler (http://projecteuler.net/problem=14) 的问题 14，但我使用 Haskell 遇到了死胡同。

现在，我知道这些数字可能足够小，我可以使用蛮力，但这不是我练习的目的。我正在尝试将中间结果记住在Map Integer (Bool, Integer) 类型的Map 中，其含义是：

- the first Integer (the key) holds the number
- the Tuple (Bool, Interger) holds either (True, Length) or (False, Number) 
                                           where Length = length of the chain
                                                 Number = the number before him

例如：

  for 13: the chain is 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
  My map should contain : 
  13 - (True, 10)
  40 - (False, 13)
  20 - (False, 40)
  10 - (False, 20)
  5  - (False, 10)
  16 - (False, 5)
  8  - (False, 16)
  4  - (False, 8)
  2  - (False, 4)
  1  - (False, 2)

现在，当我搜索另一个号码时，例如40，我知道链中有(10 - 1) length 等等。我现在想，如果我搜索 10，不仅告诉我 10 的长度是 (10 - 3) length 并更新地图，而且我想更新 20、40 以防它们仍然是（False，_）

我的代码：

import Data.Map as Map

solve :: [Integer] -> Map Integer (Bool, Integer)
solve xs    = solve' xs Map.empty
    where
        solve' :: [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
        solve' []     table = table
        solve' (x:xs) table =
            case Map.lookup x table of
                Nothing     -> countF x 1 (x:xs) table
                Just     (b, _) ->
                    case b of
                        True    -> solve' xs table
                        False   -> {-WRONG-} solve' xs table

        f :: Integer -> Integer
        f x
            | x `mod` 2 == 0    = x `quot` 2
            | otherwise     = 3 * x + 1

        countF :: Integer -> Integer -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
        countF n cnt (x:xs) table
            | n == 1    = solve' xs (Map.insert x (True, cnt) table)
            | otherwise = countF (f n) (cnt + 1) (x:xs) $ checkMap (f n) n table

        checkMap :: Integer -> Integer -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
        checkMap n rez table    =
            case Map.lookup n table of
                Nothing -> Map.insert n (False, rez) table
                Just _  -> table

在 {-WRONG-} 部分，我们应该更新所有值，如下例所示：

--We are looking for 10:
  10 - (False, 20)
     |
     V                                   {-finally-} update 10 => (True, 10 - 1 - 1 - 1)
  20 - (False, 40)                                      ^
     |                                                  |
     V                                  update 20 => 20 - (True, 10 - 1 - 1)
  40 - (False, 13)                          ^
     |                                      |
     V                      update 40 => 40 - (True, 10 - 1)
  13 - (True, 10)              ^
     |                         |
     ---------------------------

问题是我不知道它是否可以在一个函数中做两件事，比如更新一个数字并继续递归。在C 之类的语言中，我可能会执行类似（伪代码）的操作：

void f(int n, tuple(b,nr), int &length, table)
{
      if(b == False) f (nr, (table lookup nr), 0, table);
      // the bool is true so we got a length
      else
      {
            length = nr;
            return;
      }
      // Since this is a recurence it would work as a stack, producing the right output
      table update(n, --cnt);
}

最后一条指令会起作用，因为我们通过引用发送 cnt。而且我们总是知道它会在某个时候完成，并且 cnt 不应该是

【问题讨论】：

映射的值类型会更惯用地呈现为Either Integer Integer，但我认为您会发现对尚未记忆的条目没有映射会更方便。
如果你（也就是程序）知道需要更新什么，为什么不把更新后的表传给recurrence呢？
@groovy 因为我不知道在通话时（当我处于复发状态时）我应该更新什么值。在我知道答案之前，我首先必须重复多次，然后从下往上更新它们。看一下 10 的例子，我必须先到 20、40、13，然后我才知道要更新到 40、20、10。

标签： algorithm haskell implementation

【解决方案1】：

最简单的优化（如您所见）是记忆。您曾尝试自己创建一个记忆系统，但是遇到了如何存储记忆值的问题。有一些解决方案可以以可维护的方式执行此操作，例如使用 State monad 或 STArray。但是，对于您的问题，有一个更简单的解决方案 - 使用 haskell 现有的 memoization。 Haskell 默认会记住常量值，所以如果你创建一个存储 collatz 值的值，它会被自动记忆！

一个简单的例子是下面的斐波那契定义：

fib :: Int -> Integer
fib n = fibValues !! n where
  fibValues = 1 : 1 : zipWith (+) fibValues (tail fibValues)

fibValues 是一个[Integer]，因为它只是一个常数值，所以它被记忆了。然而，这并不意味着它会被一次性记住，因为它是一个无限列表，这永远不会完成。相反，这些值仅在需要时计算，因为 haskell 是惰性的。

所以如果你对你的问题做类似的事情，你会得到记忆而不需要大量的工作。但是，使用上述列表在您的解决方案中效果不佳。这是因为 collatz 算法使用许多不同的值来获取给定数字的结果，因此使用的容器将需要随机访问才能有效。显而易见的选择是数组。

collatzMemoized :: Array Integer Int

接下来，我们需要用正确的值填充数组。我将编写这个函数，假设存在一个计算任何 n 的 collatz 值的collatz 函数。另外，请注意数组是固定大小的，因此需要使用一个值来确定要记忆的最大数量。我将使用一百万，但可以使用任何值（这是内存/速度的权衡）。

collatzMemoized = listArray (1, maxNumberToMemoize) $ map collatz [1..maxNumberToMemoize] where
  maxNumberToMemroize = 1000000

这很简单，listArray 被赋予了边界，并且该范围内所有 collatz 值的列表被赋予它。请记住，这不会立即计算所有 collatz 值，因为这些值是惰性的。

现在，可以编写 collatz 函数了。最重要的部分是只检查collatzMemoized 数组，如果被检查的数字在其范围内：

collatz :: Integer -> Int
collatz 1 = 1
collatz n
  | inRange (bounds collatzMemoized) nextValue = 1 + collatzMemoized ! nextValue
  | otherwise = 1 + collatz nextValue
  where
    nextValue = case n of
      1 -> 1
      n | even n -> n `div` 2
        | otherwise -> 3 * n + 1

在 ghci 中，您现在可以看到 memoization 的有效性。试试collatz 200000。大约需要 2 秒才能完成。但是，如果您再次运行它，它会立即完成。

终于可以找到解决办法了：

maxCollatzUpTo :: Integer -> (Integer, Int)
maxCollatzUpTo n = maximumBy (compare `on` snd) $ zip [1..n] (map collatz [1..n]) where

然后打印：

main = print $ maxCollatzUpTo 1000000

如果你运行main，结果会在10秒左右打印出来。

现在，这种方法的一个小问题是它使用了大量的堆栈空间。它在 ghci 中可以正常工作（这似乎在堆栈空间方面更灵活）。但是，如果您编译它并尝试运行可执行文件，它将崩溃（堆栈空间溢出）。所以要运行程序，你必须在编译时指定更多。这可以通过将-with-rtsopts='K64m' 添加到编译选项来完成。这会将堆栈增加到 64mb。

现在程序可以编译运行了：

> ghc -O3 --make -with-rtsopts='-K6m' problem.hs

运行./problem 将在不到一秒的时间内给出结果。

【讨论】：

附注：这个词是“备忘录”——就像写备忘录一样。
@Carl：嗯，从来没有意识到，我从来没有注意到缺少的“r”。
它对你们有什么作用？！这个大小的问题一定是Int64
@SassaNF：通过运行 64 位 ghc，默认为 64 位整数。我会更新答案以使其更便携。
@DavidMiani 但是在将 Int 更改为 Int64 后，我不必更改堆栈大小，那么为什么会出现堆栈溢出？

【解决方案2】：

您正在努力进行记忆化，尝试在 Haskell 中编写命令式程序。借鉴 David Eisenstat 的解决方案，我们将按照 j_random_hacker 的建议解决它：

collatzLength :: Integer -> Integer
collatzLength n
    | n == 1 = 1
    | even n = 1 + collatzLength (n `div` 2)
    | otherwise = 1 + collatzLength (3*n + 1)

对此的动态编程解决方案是将递归替换为在表中查找内容。让我们创建一个可以替换递归调用的函数：

collatzLengthDef :: (Integer -> Integer) -> Integer -> Integer
collatzLengthDef r n
    | n == 1 = 1
    | even n = 1 + r (n `div` 2)
    | otherwise = 1 + r (3*n + 1)

现在我们可以将递归算法定义为

collatzLength :: Integer -> Integer
collatzLength = collatzLengthDef collatzLength

现在我们还可以制作一个表格版本（它需要一个数字作为表格大小，并返回一个使用该大小的表格计算的 collatzLength 函数）：

-- A utility function that makes memoizing things easier
buildTable :: (Ix i) => (i, i) -> (i -> e) -> Array i e
buildTable bounds f = array $ map (\x -> (x, f x)) $ range bounds

collatzLengthTabled :: Integer -> Integer -> Integer
collatzLengthTabled n = collatzLengthTableLookup
    where
        bounds = (1, n)
        table = buildTable bounds (collatzLengthDef collatzLengthTableLookup)
        collatzLengthTableLookup =
            \x -> Case inRange bounds x of
                True -> table ! x
                _ -> (collatzLengthDef collatzLengthTableLookup) x

这通过将 collatzLength 定义为表查找来工作，表是函数的定义，但递归调用被表查找替换。查表函数检查函数的参数是否在表的范围内，并回退到函数的定义。我们甚至可以将它用于表任何这样的函数：

tableRange :: (Ix a) => (a, a) -> ((a -> b) -> a -> b) -> a -> b
tableRange bounds definition = tableLookup
    where
        table = buildTable bounds (definition tableLookup)
        tableLookup =
            \x -> Case inRange bounds x of
                True -> table ! x
                _ -> (definition tableLookup) x

collatzLengthTabled n = tableRange (1, n) collatzLengthDef

你只需要确保你

let memoized = collatzLengthTabled 10000000
    ... memoized ...

这样内存中只建了一张表。

【讨论】：

【解决方案3】：

我记得在 Haskell 中发现动态编程算法的记忆非常违反直觉，我已经有一段时间没有这样做了，但希望以下技巧对你有用。

但首先，我不太了解您当前的 DP 方案，尽管我怀疑它可能效率很低，因为它似乎需要为每个答案更新许多条目。 (a) 我不知道如何在 Haskell 中做到这一点，并且 (b) 你不需要这样做来有效地解决问题;-)

我建议改用以下方法：首先构建一个普通的递归函数，计算输入数字的正确答案。（提示：它将有一个类似collatzLength :: Int -> Int 的签名。）当你有这个函数工作时，只需将其定义替换为一个数组的定义，该数组的元素是使用关联列表的array 函数延迟定义的，然后替换所有对函数的递归调用以进行数组查找（例如，collatzLength 42 将变为 collatzLength ! 42）。这将自动以必要的顺序填充数组！所以你的“顶级”collatzLength 对象现在实际上是一个数组，而不是一个函数。

正如我上面建议的那样，我将使用数组而不是地图数据类型来保存 DP 表，因为您需要存储从 1 到 1,000,000 的所有整数索引的值。

【讨论】：

【解决方案4】：

我手边没有 Haskell 编译器，因此对于任何损坏的代码，我深表歉意。

没有记忆，就有函数

collatzLength :: Integer -> Integer
collatzLength n
    | n == 1 = 1
    | even n = 1 + collatzLength (n `div` 2)
    | otherwise = 1 + collatzLength (3*n + 1)

使用记忆，类型签名是

memoCL :: Map Integer Integer -> Integer -> (Map Integer Integer, Integer)

因为memoCL 接收一个表格作为输入并将更新后的表格作为输出。 memoCL 需要做的是用let 的形式拦截递归调用的返回并插入新的结果。

-- table must have an initial entry for 1

memoCL table n = case Map.lookup n table of
    Just m -> (table, m)
    Nothing -> let (table', m) = memoCL table (collatzStep n) in (Map.insert n (1 + m) table', 1 + m)

collatzStep :: Integer -> Integer
collatzStep n = if even n then n `div` 2 else 3*n + 1

在某些时候，您会厌倦上述成语。然后是 monad 的时候了。

【讨论】：

【解决方案5】：

我最终修改了 {-WRONG-} 部分，通过调用 mark x (b, n) [] xs table where 来完成它应该做的事情

        mark :: Integer -> (Bool, Integer) -> [Integer] -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
        mark crtElem (b, n) list xs table
            | b == False    = mark n (findElem n table) (crtElem:list) xs table
            | otherwise = continueWith n list xs table

        continueWith :: Integer -> [Integer] -> [Integer] -> Map Integer (Bool, Integer) -> Map Integer (Bool, Integer)
        continueWith _   []     xs table    = solve' xs table
        continueWith cnt (y:ys) xs table    = continueWith (cnt - 1) ys xs (Map.insert y (True, cnt - 1) table)

        findElem :: Integer -> Map Integer (Bool, Integer) -> (Bool, Integer)
        findElem n table = 
            case Map.lookup n table of
                Nothing     -> (False, 0)
                Just (b, nr)    -> (b, nr)

但似乎有比这个 1 更好（而且更简洁）的答案

【讨论】：

【解决方案6】：

也许你会发现我是如何解决这个问题的。它非常实用，虽然它可能不是地球上最有效的东西:)

您可以在这里找到代码：https://github.com/fmancinelli/project-euler/blob/master/haskell/project-euler/Problem014.hs

P.S.：免责声明：我正在做 Project Euler 练习以学习 Haskell，因此解决方案的质量可能存在争议。

【讨论】：

【解决方案7】：

由于我们正在研究递归方案，因此这里有一个适合您。

让我们考虑函子 N(A,B,X)=A+B*X，它是一个 B 流，最后一个元素是 A。

{-# LANGUAGE DeriveFunctor
           , TypeFamilies
           , TupleSections #-}

import Data.Functor.Foldable
import qualified Data.Map as M
import Data.List
import Data.Function
import Data.Int

data N a b x = Z a | S b x deriving (Functor)

这个流对于多种迭代都很方便。例如，我们可以用它来表示 Collatz 序列中的 Ints 链：

type instance Base Int64 = N Int Int64

instance Foldable Int64 where
  project 1 = Z 1
  project x | odd x = S x $ 3*x+1
  project x = S x $ x `div` 2

这只是一个代数，而不是初始代数，因为转换不是同构（相同的 Ints 链是 2*x 和 (x-1)/3 链的一部分），但这足以表示固定点 Base Int64 Int64。

有了这个定义，cata 将把链提供给给它的代数，你可以用它来构造一个整数到链长的备忘录 Map。最后，anamorphism 可以使用它来生成不同大小问题的解决方案流：

problems = ana (uncurry $ cata . phi) (M.empty, 1) where
    phi :: M.Map Int64 Int -> 
           Base Int64 (Prim [(Int64, Int)] (M.Map Int64 Int, Int64)) ->
           Prim [(Int64, Int)] (M.Map Int64 Int, Int64)
    phi m (Z v) = found m 1 v
    phi m (S x ~(Cons (_, v') (m', _))) = maybe (notFound m' x v') (found m x) $
                                          M.lookup x m

(Cons ...) 之前的 ~ 表示惰性模式匹配。在需要值之前，我们不会触及模式。如果不是为了惰性模式匹配，它总是会构建整个链，并且使用映射将毫无用处。使用惰性模式匹配，如果 x 的链长不在映射中，我们只会构造值 v' 和 m'。

辅助函数构造 (Int, chain length) 对的流：

    found m x v = Cons (x, v) (m, x+1)
    notFound m x v = Cons (x, 1+v) (M.insert x (1+v) m, x+1)

现在只取前 999999 个问题，找出链最长的问题：

main = print $ maximumBy (compare `on` snd) $ take 999999 problems

这比基于数组的解决方案工作得慢，因为地图查找是地图大小的对数，但此解决方案不是固定大小。不过，它在大约 5 秒内完成。

【讨论】：