尝试为 Haskell 中的函数创建一个有效的算法

Posted 2023-03-27

【中文标题】尝试为 Haskell 中的函数创建一个有效的算法

【英文标题】：Trying to create an efficient algorithm for a function in Haskell

【发布时间】：2014-06-28 20:35:24

【问题描述】：

我正在寻找以下问题的有效多项式时间解决方案：

实现一个递归函数节点 x y 用于计算定义为的数字三角形中的第 (x,y) 个数字

g(x,y) = 0 if |x| > y
       = 1 if (x,y) = (0,0)
       = sum of all incoming paths otherwise

到一个节点的所有传入路径的总和定义为从根节点 (x, y) = (0, 0) 到所考虑的节点的所有可能路径的值的总和，其中在每个节点 ( x,y) 路径可以沿对角线向下和向左 (x−1,y+1)、直线向下 (x,y+1) 或对角线向下和向右 (x+1,y+1) 继续。到节点的路径的值定义为沿该路径的所有节点的总和，直到但不包括所考虑的节点。

表格中给出了数字三角形中的前几个条目：

\  x  -3  -2  -1  0  1  2  3 
 \  
y \ _________________________
   |
0  |   0   0   0  1  0  0  0
   |
1  |   0   0   1  1  1  0  0
   |
2  |   0   2   4  6  4  2  0
   |
3  |   4   16  40 48 40 16 4

我正在尝试首先制定一个幼稚的解决方案，这就是我所拥有的：

node x y | y < 0                = error "number cannot be negative"
         | (abs x) > y          = 0
         | (x == 0) && (y == 0) = 1
         | otherwise            = node (x+1) (y-1) + node x (y-1) + node (x-1) (y-1)

每当我运行它时，我都会得到：

“*异常：堆栈溢出”？

【问题讨论】：

请注意，您可以使用en.wikipedia.org/wiki/Triangular_number中给出的封闭形式表达式有效地计算三角数

您所描述的是帕斯卡三角形的概括。见this论文。

【参考方案1】：

我相信您的问题比您的示例代码建议的要复杂一些。首先，让我们在这里明确一些定义：

设pathCount x y 为以 (x, y) 结尾的路径数。我们有

pathCount :: Int -> Int -> Integer
pathCount x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]

现在让我们pathSum x y 是所有以 (x, y) 结尾的路径的总和。我们有：

pathSum :: Int -> Int -> Integer
pathSum x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
                     | d <- [-1..1] ]

有了这个助手，我们终于可以正确定义node x y了：

node :: Int -> Int -> Integer
node x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]

这种算法本身是当前形式的指数时间。然而，我们可以添加memoization 以使添加的数量成为二次方。 Hackage 上的memoize 软件包让这一切变得简单。完整示例：

import Control.Monad
import Data.List (intercalate)
import Data.Function.Memoize (memoize2)

node' :: Int -> Int -> Integer
node' x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]
node = memoize2 node'

pathCount' :: Int -> Int -> Integer
pathCount' x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]
pathCount = memoize2 pathCount'

pathSum' :: Int -> Int -> Integer
pathSum' x y
  | y == 0 = if x == 0 then 1 else 0
  | otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
                     | d <- [-1..1] ]
pathSum = memoize2 pathSum'

main =
  forM_ [0..n] $ \y ->
     putStrLn $ intercalate " " $ map (show . flip node y) [-n..n]
  where n = 5

输出：

0 0 0 0 0 1 0 0 0 0 0
0 0 0 0 1 1 1 0 0 0 0
0 0 0 2 4 6 4 2 0 0 0
0 0 4 16 40 48 40 16 4 0 0
0 8 72 352 728 944 728 352 72 8 0
16 376 4248 16608 35128 43632 35128 16608 4248 376 16

正如您所看到的算法，数字的大小很快就会失控。所以运行时间不是 O(n^2)，而算术运算的次数是。

【讨论】：

谢谢你。我会仔细研究代码以确保我理解所有内容。但有一件事，当尝试加载第二部分（它在它自己的 .hs 文件中）时，我在第 20 行“输入'import'时出现解析错误”出现错误？

@user3625479 第 20 行是什么？导入应该在顶部。

导入在顶部，第 20 行是 pathSum 的第二个守卫，即 |否则 = sum [ pathSum (x + d) (y-1) ...

@user3625479 我只能假设你在这里做错了什么。也许您正在尝试编译/加载错误的文件？它绝对不应该抱怨import 在没有import 的行中。如果我将该代码逐字放入文件中，我可以使用 GHC 毫无问题地编译它（并将其加载到 GHCi 中）

我觉得这很奇怪！这绝对是正确的文件。我注意到我在第 3 行也收到错误：“找不到模块 `Data.Function.Memoize' 使用 -v 查看搜索的文件列表。”

【参考方案2】：

您正在考虑传出路径，而您应该考虑传入路径。您的递归步骤当前是从下方而不是上方寻找节点。

【讨论】：

请注意，除非函数被记忆，否则自下而上对三角数的幼稚解决方案将非常低效。

那么我是否只需将其他防护装置中的标志反转为从上方而不是下方查看？

是的。考虑：在确定位置 (4,2) 处的数字应该是多少时，您会查看其他三个节点吗？ （提示：不是第三行）

我不认为重复是那么简单。你真的看过 OP 的例子吗？

我已经更改了 else 守卫中的代码以反映我所做的事情，但它没有产生正确的答案？

【参考方案3】：

首先，很抱歉，如果这很长。我想解释一步一步的思考过程。

首先，您需要一个关键事实：您可以通过路径列表在每个“索引”处表示“答案”。对于所有零，这是[[]]，对于您的基本情况，它是[[1]]，例如，对于0,2，它是[[6,1,1],[6,1,1],[6,1,1]]。这可能看起来有些冗余，但它简化了未来的事情。然后，如果列表不为空，则提取答案为head . head，如果为空，则为const 0。

这非常有用，因为您可以将答案存储为行列表（第一行将是 '[[1]], [], [] ...），并且任何给定行的结果仅取决于前一行。

其次，这个问题是对称的。这很明显。

我们要做的第一件事将非常接近地反映fib 的定义：

type Path = [[Integer]]

triangle' :: [[Path]]
triangle' = ([[1]] : repeat []) : map f triangle' 

我们知道这必须接近正确，因为第二行将仅取决于第一行，第三行仅取决于第二行，依此类推。所以结果将是

([[1]] : repeat []) : f ([[1]] : repeat []) : f ....

现在我们只需要知道f 是什么。首先，它的类型：[Path] -> [Path]。很简单，给定上一行，返回下一行。

现在您可能会看到另一个问题。每次调用f 都需要知道当前行中有多少列。我们实际上可以计算上一行中非空元素的长度，但是直接传递参数更简单，所以我们将map f triangle'更改为zipWith f [1..] triangle'，给f类型Int -> [Path] -> [Path]。

f 需要处理一种特殊情况和一种一般情况。特殊情况是x=0，在这种情况下，我们只需将x+1,y-1 和x-1,y-1 递归视为相同，否则与gn 相同。让我们创建两个函数，g0 和 gn 来处理这两种情况。

gn 的实际计算很简单。我们知道对于一些x，我们需要上一行的元素x-1, x, x+1。因此，如果我们在将上一行提供给gn 的xth 调用之前删除x-1 元素，gn 可以只取前3 个元素，它就会有它需要的东西。我们这样写：

f :: Int -> [Path] -> [Path]
f n ps = g0 ps : map (gn . flip drop ps) [0..n-1] ++ repeat []

末尾的repeat [] 应该很明显：对于三角形外的索引，结果是0。

现在写g0和gs真的很简单：

g0 :: [Path] -> Path 
g0 (a:b:_) =  map (s:) q 
  where 
    s = sum . concat $ q
    q = b ++ a ++ b 

gn :: [Path] -> Path 
gn (a:b:c:_) = map (s:) q 
  where 
    s = sum . concat $ q
    q = a ++ b ++ c

在我的机器上，这个版本比我用普通递归和记忆化编写的最快版本快大约 3-4 倍。

剩下的只是打印或拉出你想要的号码。

triangle :: Int -> Int -> Integer
triangle x y = case (triangle' !! y) !! (abs x) of 
                 [] -> 0
                 xs -> head $ head xs 

triList :: Int -> Int -> Path
triList x y = (triangle' !! y) !! (abs x) 

printTri :: Int -> Int -> IO ()
printTri width height = 
  putStrLn $ unlines $ map unwords 
   [[ p $ triangle x y | x <- [-x0..x0]] | y <- [0..height]]
      where maxLen = length $ show $ triangle 0 height 
            x0 = width `div` 2
            p = printf $ "%" ++ show maxLen ++ "d " 

【讨论】：

那不是指数时间吗？