Search code examples
haskelltransitive-closure

Transitive closure from a list using Haskell


I need to produce transitive closure on list using Haskell.

So far I got this:

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]

Output 1:

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

Output 2:

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

The problem is with second output. Instead of checking for additional transitive closure on the new produced list, it just returns result.

To prototype haskell code I used this Python code:

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)])

This is right output that I need in my Haskell function.

How to do the same thing in my Haskell code? (I need to recreate if statement from Python code to the Haskell code)


Solution

  • I'm not entirely certain of what you're trying to do in your Haskell code. Instead, we could just port your Python code to Haskell.

    For the sake of simplicity, let's just stick to lists instead of involving sets. If you really need performance, using sets isn't that much more difficult; however, we can't use comprehensions for sets in Haskell without some serious acrobatics¹. If we don't mind slower code, we could just use nub² to get the same effect with lists.

    I like to start writing functions with the type signature; it makes it easier to think about exactly what I'm implementing. We're taking a list of pairs and producing another list of pairs. This means the type is going to roughly be:

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

    However, we want to be able to compare the left and right part of the pairs to each other with ==. This means they have to be the same type and they have to support ==. So the actual type is:

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

    Now let's look at your actual algorithm. The main part is the while True loop. We want to transform this to recursion. The best way to think about recursion is to break it up into the base case and the recursive case. For a loop, this corresponds roughly to the stopping condition and the loop body.

    So what is the base case? In your code, the loop's exit condition is hidden inside the body. We stop when closure_until_now == closure. (This is the if-statement you mentioned in your question, coincidentally.)

    In a function definition, we can specify logic like this with guards, so the first part of our recursive function looks like this:

    transitiveClosure closure 
      | closure == closureUntilNow = closure
    

    This acts just like your if statement. Of course, we haven't defined closureUntilNow yet! So let's do that next. This is just a helper variable, so we put it in a where block after the function definition. We can define it using the same comprehension as in your Python code, with nub to ensure it remains unique:

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

    This code does the equivalent of the first two lines in your while loop.

    Finally, we just need our recursive case. What do we do if we are not done yet? In your while loop, you just set closure to closureUntilNow and iterate again. We'll do exactly the same thing with a recursive call:

      | otherwise = transitiveClosure closureUntilNow
    

    Since this is part of the pattern guard, it goes above the where block. So, putting it all together, we get:

    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']
    

    Hopefully this makes the thinking involved in writing this program clear.

    ¹This is difficult because Set does not form a Haskell Monad. It is a monad in a more general sense, but it doesn't conform to the class in the Prelude. So we can't just use monad comprehensions. We could use monad comprehensions with rebindable syntax to get there, but it's just not worth it.

    ²nub is a stupidly named function that removes duplicates from a list. I think OCaml's dedup is a much better name for it.