haskell - Haskell 中图的传递闭包

Question

以下程序的目的是关系的传递闭包(作为一组有序对 - 一个图)以及关于有序对与该关系的成员资格的测试。

我尝试通过使用 Data.Set 而不是列表来提高程序效率，并消除生成缺失对时的冗余。

我想知道:

1. 如何使用QuickCheck验证其正确性；
2. 如果可能的话，如何计算程序的效率，或者 它与问题的类似解决方案相比如何(例如 Transitive closure from a list )。

如有任何批评和建议，我们将不胜感激。

import Data.Set as S
import Data.Foldable as F (foldMap)

data TruthValue = F | U | T deriving (Show,Eq)

isMemberOfTransitiveGraph :: Ord t => (t, t) -> Set (t, t) -> TruthValue
(x,y) `isMemberOfTransitiveGraph` gr
  | S.member (x,y) closure = T -- as suggested by user5402
  | S.member (y,x) closure = F -- as suggested by user5402
  | otherwise = U
  where
  closure = transitiveClusureOfGraph gr -- as suggested by user5402

transitiveClusureOfGraph :: Ord a => Set (a, a) -> Set (a, a)
transitiveClusureOfGraph gr = F.foldMap (transitiveClosureOfArgument gr) domain
  where
  domain = S.map fst gr

transitiveClosureOfArgument :: Ord a => Set (a, a) -> a -> Set (a, a)
transitiveClosureOfArgument gr x = S.map ((,) x) $ recursiveImages gr (S.singleton x)

recursiveImages :: Ord a => Set (a, a) -> Set a -> Set a
recursiveImages gr imgs = f gr imgs S.empty
  where
  f :: Ord a => Set (a, a) -> Set a -> Set a -> Set a
  f gr imgs acc
    | S.null imgs = acc
    | otherwise = f gr (newImgs S.\\ acc) (S.union newImgs acc)
    where
    newImgs = F.foldMap (imaginsOf gr) imgs

imaginsOf :: (Ord b, Eq a) => Set (a, b) -> a -> Set b
imaginsOf gr arg =  S.foldr (\(a,b) acc -> if a == arg then S.insert b acc else acc) S.empty gr

**

示例 1

**

someLessThan = S.fromList [("1","2"),("1","4"),("3","4"),("2","8"),("3","5"),("4","7"),("4","8"),("3","9")]

> transitiveClusureOfGraph someLessThan
> fromList [("1","2"),("1","4"),("1","7"),("1","8"),("2","8"),("3","4"),("3","5"),("3","7"),("3","8"),("3","9"),("4","7"),("4","8")]

a `isLessThan` b = (a,b) `isMemberOfTransitiveGraph`  someLessThan
> "1" `isLessThan` "8"
> T
> "8" `isLessThan` "1"
> F
> "1" `isLessThan` "9"
> U
> "9" `isLessThan` "1"
> U

**

示例 2

**

someTallerThan = S.fromList  [("Alexandre","Andrea"),("Andrea","John"),("George","Frank"),("George","Lucy"),("John","Liza"),("Julia","Lucy"),("Liza","Bob"),("Liza","Frank")]

> transitiveClusureOfGraph someTallerThan
> fromList [("Alexandre","Andrea"),("Alexandre","Bob"),("Alexandre","Frank"),("Alexandre","John"),("Alexandre","Liza"),("Andrea","Bob"),("Andrea","Frank"),("Andrea","John"),("Andrea","Liza"),("George","Frank"),("George","Lucy"),("John","Bob"),("John","Frank"),("John","Liza"),("Julia","Lucy"),("Liza","Bob"),("Liza","Frank")]

a `isTallerThan` b = (a,b) `isMemberOfTransitiveGraph` someTallerThan
> "Alexandre" `isTallerThan` "Frank"
> T
> "Frank" `isTallerThan` "Alexandre"
> F
> "Alexandre" `isTallerThan` "George"
> U
> "George" `isTallerThan` "Alexandre"
> U

**

示例 3

**

incomeIsLessOrEqualThan = S.fromList [("Bob","Liza"),("Liza","Tom"),("Tom","Bob"),("Tom","Mary"),   ("Tom","Tom")]

> S.filter (\(a,b) -> a /= b) $ transitiveClusureOfGraph incomeIsLessOrEqualThan

> fromList [("Bob","Liza"),("Bob","Mary"),("Bob","Tom"),("Liza","Bob"),("Liza","Mary"),("Liza","Tom"),("Tom","Bob"),("Tom","Liza"),("Tom","Mary")]

Answer 1

一些评论:

1. Quickcheck 测试的一些想法:

   • 创建一个随机连通图并验证每对点都位于传递闭包中。
   • 验证对于任何随机图，传递闭包的传递闭包与只执行一次传递闭包是一样的。
   • 验证您的代码是否返回与其他实现(例如来自 fgl 库)相同的答案。

但是，当我查看 fgl 库时，我发现他们只是使用固定图来测试其路径查询功能。然后他们确切地知道所有测试的答案应该是什么。

另一个想法是解决 ACM(编程竞赛)问题，其中涉及找到图的传递闭包，并在该解决方案中使用您的代码。两者Timus和 codeforces接受 Haskell 程序。

在 isMemberOfTransitiveGraph 中，您有公共(public)子表达式 transitiveClusureOfGraph gr。现在 GHC 可以(并且应该)检测到这一点并将其分解出来，这样就不会对其进行两次评估，但它并不总是这样做。此外，作为解释器，ghci 不会执行常见的子表达式消除。因此，鉴于 transitiveClusureOfGraph 是一项昂贵的操作，您应该像这样编写这个函数

这个:

isMemberOfTransitiveGraph (x,y) gr
  | S.member (x,y) closure = T
  | S.member (y,x) closure = F
  | otherwise              = U
  where
    closure = transitiveClusureOfGraph gr in

此外，计算整个图的传递闭包是 确定特定对是否在闭包中的昂贵方法。 实现 isMemberOfTransitiveClosure 的更好方法是简单地 从该对中的一个成员开始执行深度优先搜索，直到 a) 找到另一个元素或 b) 填写连接组件但找不到另一个元素。否则，您将在其他连接的组件上执行大量工作，这与您要回答的问题无关。

如果您确实关心效率，请将节点类型限制为 Int 并使用 Data.IntSet 甚至 Data.BitSet > 对于节点集。