使用 Haskell 从列表传递闭包

我需要使用 Haskell 在列表上生成传递闭包。

到目前为止我得到了这个：

import Data.List
qq [] = []
qq [x] = [x]
qq x = vv (sort x)

vv (x:xs) = [x] ++ (member [x] [xs]) ++  (qq xs)

member x [y] = [(x1, y2) | (x1, x2) <- x, (y1, y2) <- qq (y), x2 == y1]

输出1：

*Main> qq [(1,2),(2,3),(3,4)]
[(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]

输出2：

*Main> qq [(1,2),(2,3),(3,1)]
[(1,2),(1,3),(1,1),(2,3),(2,1),(3,1)]

问题出在第二个输出上。它不检查新生成的列表上是否有额外的传递闭包，而是仅返回结果。

为了原型化 Haskell 代码，我使用了这个Python代码:

def transitive_closure(angel):
    closure = set(angel)
    while True:
        new_relations = set((x,w) for x,y in closure for q,w in closure if q == y)
        closure_until_now = closure | new_relations    
        if closure_until_now == closure:
            break    
        closure = closure_until_now    
    return closure

print transitive_closure([(1,2),(2,3),(3,1)])

Output:

set([(1, 2), (3, 2), (1, 3), (3, 3), (3, 1), (2, 1), (2, 3), (2, 2), (1, 1)])

这是我的 Haskell 函数中需要的正确输出。

如何在我的 Haskell 代码中做同样的事情？ （我需要重新创建if从 Python 代码到 Haskell 代码的语句）

我不完全确定你想在 Haskell 代码中做什么。相反，我们可以将 Python 代码移植到 Haskell。

为了简单起见，我们只使用列表而不涉及集合。如果您确实需要性能，那么使用集合并没有那么困难；然而，如果没有一些严肃的杂技，我们就无法在 Haskell 中使用集合推导式。如果我们不介意较慢的代码，我们可以使用nub² 获得与列表相同的效果。

我喜欢用类型签名开始编写函数；它让我更容易思考我正在实施的具体内容。我们正在获取一个对列表并生成另一个对列表。这意味着该类型将roughly be:

[(a, b)] → [(a, b)]

然而，我们希望能够将这些对的左右部分相互比较==。这意味着他们必须是same类型并且他们必须支持==。所以实际的类型是：

transitiveClosure ∷ Eq a ⇒ [(a, a)] → [(a, a)]

现在让我们看看您的实际算法。主要部分是while True环形。我们想将其转换为递归。考虑递归的最佳方法是将其分解为基本情况和递归情况。对于循环，这大致对应于停止条件和循环体。

那么基本情况是什么？在您的代码中，循环的退出条件隐藏在主体内部。我们停下来时closure_until_now == closure。 （巧合的是，这就是您在问题中提到的 if 语句。）

在函数定义中，我们可以指定这样的逻辑：guards，所以我们的递归函数的第一部分如下所示：

transitiveClosure closure 
  | closure == closureUntilNow = closure

这就像你的if陈述。当然，我们还没有定义closureUntilNow然而！那么接下来我们就这样做吧。这只是一个辅助变量，所以我们把它放在where函数定义之后的块。我们可以使用与 Python 代码中相同的理解方式来定义它：nub确保它保持唯一：

  where closureUntilNow = 
          nub $ closure ++  [(a, c) | (a, b) ← closure, (b', c) ← closure, b == b']

此代码的作用相当于 while 循环中的前两行。

最后，我们只需要递归案例。如果我们是这样，我们该怎么办not完成了吗？在你的while循环，你刚刚设置closure to closureUntilNow并再次迭代。我们将通过递归调用执行完全相同的操作：

  | otherwise = transitiveClosure closureUntilNow

由于这是模式保护的一部分，因此它会above the where堵塞。所以，把它们放在一起，我们得到：

transitiveClosure ∷ Eq a ⇒ [(a, a)] → [(a, a)]
transitiveClosure closure 
  | closure == closureUntilNow = closure
  | otherwise                  = transitiveClosure closureUntilNow
  where closureUntilNow = 
          nub $ closure ++ [(a, c) | (a, b) ← closure, (b', c) ← closure, b == b']

希望这能让编写这个程序的思路变得清晰。

¹这很困难，因为Set不形成Haskell Monad。它是更一般意义上的 monad，但它不符合 Prelude 中的类。所以我们不能只使用 monad 推导式。我们could使用具有可重新绑定语法的 monad 推导式来实现这一目标，但这并不值得。

²nub是一个名称愚蠢的函数，用于从列表中删除重复项。我认为 OCaml 的dedup is a much更好的名字。