使用 Haskell 从列表传递闭包

Question

我需要使用 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)])

输出：

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

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

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

Answer 1

我不完全确定您要在 Haskell 代码中执行的操作。相反，我们可以将您的 Python 代码移植到 Haskell。

为了简单起见，让我们坚持使用列表而不是涉及集合。如果你真的需要性能，使用集合并没有那么困难。但是，如果没有一些严肃的杂技，我们就不能在 Haskell 中使用对集合的理解¹。如果我们不介意较慢的代码，我们可以使用nub² 来获得与列表相同的效果。

我喜欢用类型签名开始编写函数；它使我更容易思考我正在实施的确切内容。我们正在获取一个配对列表并生成另一个配对列表。这意味着类型将大致是：

[(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 循环中的前两行。

最后，我们只需要递归案例。如果我们还没有完成，我们该怎么办？在您的 while 循环中，您只需将 closure 设置为 closureUntilNow 并再次迭代。我们将通过递归调用做同样的事情：

  | otherwise = transitiveClosure closureUntilNow

由于这是模式保护的一部分，它高于 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 推导来实现，但这并不值得。

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

Answer 2

我不知道你的haskell代码应该做什么，所以我将你的python代码逐字（尽可能接近）翻译成haskell。

import Data.List
transitive_closure angel 
    | closure_until_now == closure = closure
    | otherwise                    = transitive_closure closure_until_now

        where new_relations = nub [(x,w) | (x,y) <- closure, (q,w) <- closure, q == y] 
              closure = nub angel
              closure_until_now = closure `union` new_relations

让我们通过python，分析一下Haskell中哪一行对应什么。

closure = set(angel) => closure = nub angel。 nub 就是 set。

while True: => 没什么！ Haskell 中没有“while”循环，因此递归是您唯一的选择。

new_relations = set((x,w) for x,y in closure for q,w in closure if q == y)
closure_until_now = closure | new_relations

变成

new_relations = nub [(x,w) | (x,y) <- closure, (q,w) <- closure, q == y]
closure_until_now = closure `union` new_relations

本质上是一样的。并不是说声明的顺序无关紧要，因为它们不像命令式语言那样“执行”。

if closure_until_now == closure:
    break

变成

| closure_until_now == closure = closure

我假设你熟悉守卫。 If not, many before me have done a much better job explaining. python 代码的语义说“如果这个条件为真，我们退出循环并转到'返回闭包'”。由于 Haskell 中没有循环，所以当你遇到退出条件时，你只需返回一个值，而不是递归。

closure = closure_until_now 

变成

| otherwise                    = transitive_closure closure_until_now

如果你通过了退出条件，python 将继续循环。循环的下一次迭代将使用 'closure' 作为其输入，我们将其设置为 closure_until_now 。因此，在 Haskell 版本中，“循环”（即递归函数）的下一次“迭代”将采用 closure_until_now 作为输入。

为了更稳健，您应该使用Data.Set。 Set 的唯一问题是您不能对它使用列表理解。但是，您可以用maps 轻松替换列表推导式，Set 存在：

for = flip map
new_relations = nub $ concat $ concat $ 
                for closure (\(x,y) -> 
                    for closure (\(q,w) -> 
                                 if q == y then [(x,w)] else []
                                 )
                             )

这有点小技巧，如果条件不成立，我只是使用列表来“不返回任何内容”。在这种情况下，使用Maybe 之类的东西可能会更好。