Transitive closure of a graph in Haskell

Question

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

I tried to make the program efficient through the use of Data.Set instead of lists and eliminating redundancies in the generation of the missing pair.

I would like to know:

1. how to use QuickCheck to verify its correctness;
2. how calculate the efficiency of the program, if it is possible, or how does it compare with similar solutions of the problem (ex. Transitive closure from a list ).

Any criticism and suggestion will 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")]

Answer 1

Some comments:

1. Some ideas for Quickcheck tests:

   • Create a random connected graph and verify that every pair of points is in the transitive closure.
   • Verify that for any random graph the transitive closure of the transitive closure is just the same as doing the transitive closure just once.
   • Verify that your code returns the same answer as another implementation (such as from the fgl library.)

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

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

2. In isMemberOfTransitiveGraph you have the common sub-expression transitiveClusureOfGraph gr. Now GHC could (and should) detect this and factor it out so that it doesn't get evaluated twice, but it doesn't always do that. Moreover, being an interpreter, ghci won't perform common sub-expression elimination. So, given that transitiveClusureOfGraph is an expensive operation, you should write this function like

this:

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

3. Also, computing the transitive closure for the entire graph is an expensive way to determine if a specific pair is in the closure. A better way to implement isMemberOfTransitiveClosure is to simply perform a depth-first search start at one member of the pair until you a) either find the other element or b) fill out the connected component without finding the other element. Otherwise you are performing a lot of work on the other connected components which is irrelevant to the question you are trying to answer.

4. If you are really concerned about efficiency, restrict your node type to Int and use Data.IntSet or even Data.BitSet for sets of nodes.