Clever Geek Handbook

Haskell transitive graph closure

The following program has as its goal the transitive closure of a relation (as a set of ordered pairs - a graph) and a test about the belonging of an ordered pair to this relation.

I tried to make the program efficient by using Data.Set instead of lists and eliminating redundancy in generating the missing pair.

I'd like to know:

  • how to use QuickCheck to check if it is correct;
  • how to calculate the effectiveness of the program, if possible, or how it compares to similar solutions to the problem (eg, Transient Closure from a list ).

Any criticism and suggestion would be appreciated.

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

**

EXAMPLE 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

**

EXAMPLE 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

**

EXAMPLE 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")]
+3


source to share


1 answer


Some comments:

  • Some ideas for Quickcheck tests:

    • Create a random connected graph and make sure each pair of points is in transitive closure.
    • Make sure that for any random graph the transitive closure of the transitive closure is the same as the transitive closure only once.
    • Make sure your code returns the same response as the other implementation (e.g. from the fgl library .)

However, when I look at the fgl library I see that they are just using a fixed graph to test their path request functions. Then they know exactly what the answers should be for all tests.

Another idea is to solve the ACM (programming) problem, which involves finding the transitive closure of the graph and using your code in that solution. Both Timus and codeforces accept Haskell programs.



  1. In isMemberOfTransitiveGraph

    you have a general subexpression transitiveClusureOfGraph gr

    . Now the GHC can (and should) detect this and decompose it so that it doesn't get evaluated twice, but it doesn't always do it. Moreover, being an interpreter, ghci will not perform generic sub-expression exclusion. So, considering which transitiveClusureOfGraph

    is an expensive operation, you should write this function like

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

  1. Also, calculating the transitive closure for an entire graph is an expensive way to determine if a particular pair is in a closure. The best way to implement isMemberOfTransitiveClosure

    is simply search for the beginning of depth in one member of the pair until you a) find another element, or b) fill in the connected component without finding another element. Otherwise, you are doing a lot of work on other related components that are irrelevant to the question you are trying to answer.

  2. If you are really concerned about efficiency, restrict the node type Int

    and use Data.IntSet

    or even Data.BitSet

    for nodesets.

+1


source






More articles:


All Articles