Relation.lhs
Building Relations and Graphs on top of the Set ADT.
(c) Simon Thompson, 1995, 1998.
> module Relation where
> import Set
> import List hiding ( union )
A relation is a set of pairs.
> type Relation a = Set (a,a)
Operations over relations.
^^^^^^^^^^^^^^^^^^^^^^^^^^
The image of an element under a relation.
> image :: Ord a => Relation a -> a -> Set a
> image rel val = mapSet snd (filterSet ((==val).fst) rel)
The image of a set of elements under a relation.
> setImage :: Ord a => Relation a -> Set a -> Set a
> setImage rel = unionSet . mapSet (image rel)
The union of a set of sets.
> unionSet :: Ord a => Set (Set a) -> Set a
> unionSet = foldSet union empty
Add to a set its image under a relation.
> addImage :: Ord a => Relation a -> Set a -> Set a
> addImage rel st = st `union` setImage rel st
Add the children (under the relation isParent) to a set.
> type People = String
> isParent :: Relation People
> isParent = isParent -- dummy definition
> -- needs to be replaced
> addChildren :: Set People -> Set People
> addChildren = addImage isParent
Compose two relations.
> compose :: Ord a => Relation a -> Relation a -> Relation a
> compose rel1 rel2
> = mapSet outer (filterSet equals (setProduct rel1 rel2))
> where
> equals ((a,b),(c,d)) = (b==c)
> outer ((a,b),(c,d)) = (a,d)
The product of two sets.
> setProduct :: (Ord a,Ord b) => Set a -> Set b -> Set (a,b)
> setProduct st1 st2 = unionSet (mapSet (adjoin st1) st2)
Add an element to each element of a set, forming a set of pairs.
> adjoin :: (Ord a,Ord b) => Set a -> b -> Set (a,b)
> adjoin st el = mapSet (addEl el) st
> where
> addEl el el' = (el',el)
The transitive closure of a relation.
> tClosure :: Ord a => Relation a -> Relation a
> tClosure rel = limit addGen rel
> where
> addGen rel' = rel' `union` compose rel' rel
Finding a limit of a function.
> limit :: Eq a => (a -> a) -> a -> a
> limit f xs
> | xs == next = xs
> | otherwise = limit f next
> where
> next = f xs
Graphs
^^^^^^
The connected components of a graph.
> connect :: Ord a => Relation a -> Relation a
> connect rel = clos `inter` solc
> where
> clos = tClosure rel
> solc = inverse clos
The inverse of a relation swap all pairs.
> inverse :: Ord a => Relation a -> Relation a
> inverse = mapSet swap
> where
> swap (x,y) = (y,x)
The equivalence classes of a(n equivalence) relation.
> classes :: Ord a => Relation a -> Set (Set a)
> classes rel
> = limit (addImages rel) start
> where
> start = mapSet sing (eles rel)
The auxiliary functions used in classes.
> eles :: Ord a => Relation a -> Set a
> eles rel = mapSet fst rel `union` mapSet snd rel
> addImages :: Ord a => Relation a -> Set (Set a) -> Set (Set a)
> addImages rel = mapSet (addImage rel)
Searching in graphs
^^^^^^^^^^^^^^^^^^^
The descendants v under rel which lie outside st.
> newDescs :: Ord a => Relation a -> Set a -> a -> Set a
> newDescs rel st v = image rel v `diff` st
Breaking the abstraction barrier for sets.
> flatten :: Set a -> [a]
> flatten = flatten -- dummy definition
Under the list implementation, we can use
flatten = id
A list of new descendants.
> findDescs :: Ord a => Relation a -> [a] -> a -> [a]
> findDescs rel xs v = flatten (newDescs rel (makeSet xs) v)
Breadth first search.
^^^^^^^^^^^^^^^^^^^^^
> breadthFirst :: Ord a => Relation a -> a -> [a]
> breadthFirst rel val
> = limit step start
> where
> start = [val]
> step xs = xs ++ nub (concat (map (findDescs rel xs) xs))
Depth first search.
^^^^^^^^^^^^^^^^^^^^^
> depthFirst :: Ord a => Relation a -> a -> [a]
> depthSearch :: Ord a => Relation a -> a -> [a] -> [a]
> depthFirst rel v = depthSearch rel v []
> depthSearch rel v used
> = v : depthList rel (findDescs rel used' v) used'
> where
> used' = v:used
> depthList :: Ord a => Relation a -> [a] -> [a] -> [a]
> depthList rel [] used = []
> depthList rel (val:rest) used
> = next ++ depthList rel rest (used++next)
> where
> next
> | elem val used = []
> | otherwise = depthSearch rel val used
From the exercises...
distance :: Eq a => Relation a -> a -> a -> Int