-------------------------------------------------------------------------
-- 
--         Relation.hs              
--
--         Building Relations and Graphs on top of the Set ADT.         
--  
--         (c) Addison-Welsey, 1996-2011.                   
--        
---------------------------------------------------------------------------
                
                                                                       
module Relation where

import Set
import Data.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 :: forall a. Ord a => Relation a -> a -> Set a
image Relation a
rel a
val = ((a, a) -> a) -> Relation a -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a) -> Bool) -> Relation a -> Relation a
forall a. (a -> Bool) -> Set a -> Set a
filterSet ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
val)(a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, a) -> a
forall a b. (a, b) -> a
fst) Relation a
rel)
--  
-- The image of a set of elements under a relation.     
--  
setImage :: Ord a => Relation a -> Set a -> Set a

setImage :: forall a. Ord a => Relation a -> Set a -> Set a
setImage Relation a
rel = Set (Set a) -> Set a
forall a. Ord a => Set (Set a) -> Set a
unionSet (Set (Set a) -> Set a) -> (Set a -> Set (Set a)) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a) -> Set a -> Set (Set a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (Relation a -> a -> Set a
forall a. Ord a => Relation a -> a -> Set a
image Relation a
rel) 

-- The union of a set of sets.                  
--  
unionSet :: Ord a => Set (Set a) -> Set a

unionSet :: forall a. Ord a => Set (Set a) -> Set a
unionSet = (Set a -> Set a -> Set a) -> Set a -> Set (Set a) -> Set a
forall a. (a -> a -> a) -> a -> Set a -> a
foldSet Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
forall a. Set a
empty
--  
-- Add to a set its image under a relation.         

addImage :: Ord a => Relation a -> Set a -> Set a

addImage :: forall a. Ord a => Relation a -> Set a -> Set a
addImage Relation a
rel Set a
st = Set a
st Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Set a -> Set a
forall a. Ord a => Relation a -> Set a -> Set a
setImage Relation a
rel Set a
st
--  
-- Add the children (under the relation isParent) to a set. 
--  
type People = String

isParent :: Relation People

isParent :: Relation People
isParent = Relation People
isParent   --  dummy definition
                      --  needs to be replaced

addChildren :: Set People -> Set People

addChildren :: Set People -> Set People
addChildren = Relation People -> Set People -> Set People
forall a. Ord a => Relation a -> Set a -> Set a
addImage Relation People
isParent 
--  
-- Compose two relations.                       
--  
compose :: Ord a => Relation a -> Relation a -> Relation a

compose :: forall a. Ord a => Relation a -> Relation a -> Relation a
compose Relation a
rel1 Relation a
rel2
  =  (((a, a), (a, a)) -> (a, a)) -> Set ((a, a), (a, a)) -> Relation a
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet ((a, a), (a, a)) -> (a, a)
forall {a} {b} {a} {b}. ((a, b), (a, b)) -> (a, b)
outer ((((a, a), (a, a)) -> Bool)
-> Set ((a, a), (a, a)) -> Set ((a, a), (a, a))
forall a. (a -> Bool) -> Set a -> Set a
filterSet ((a, a), (a, a)) -> Bool
forall {a} {a} {b}. Eq a => ((a, a), (a, b)) -> Bool
equals (Relation a -> Relation a -> Set ((a, a), (a, a))
forall a b. (Ord a, Ord b) => Set a -> Set b -> Set (a, b)
setProduct Relation a
rel1 Relation a
rel2))
     where
     equals :: ((a, a), (a, b)) -> Bool
equals ((a
a,a
b),(a
c,b
d)) = (a
ba -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
c)
     outer :: ((a, b), (a, b)) -> (a, b)
outer  ((a
a,b
b),(a
c,b
d)) = (a
a,b
d)

-- The product of two sets.                 
--  
setProduct :: (Ord a,Ord b) => Set a -> Set b -> Set (a,b)

setProduct :: forall a b. (Ord a, Ord b) => Set a -> Set b -> Set (a, b)
setProduct Set a
st1 Set b
st2 = Set (Set (a, b)) -> Set (a, b)
forall a. Ord a => Set (Set a) -> Set a
unionSet ((b -> Set (a, b)) -> Set b -> Set (Set (a, b))
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (Set a -> b -> Set (a, b)
forall a b. (Ord a, Ord b) => Set a -> b -> Set (a, b)
adjoin Set a
st1) Set b
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 :: forall a b. (Ord a, Ord b) => Set a -> b -> Set (a, b)
adjoin Set a
st b
el = (a -> (a, b)) -> Set a -> Set (a, b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (b -> a -> (a, b)
forall {b} {a}. b -> a -> (a, b)
addEl b
el) Set a
st
               where
               addEl :: b -> a -> (a, b)
addEl b
el a
el' = (a
el',b
el)
--  
-- The transitive closure of a relation.                 

tClosure :: Ord a => Relation a -> Relation a

tClosure :: forall a. Ord a => Relation a -> Relation a
tClosure Relation a
rel = (Relation a -> Relation a) -> Relation a -> Relation a
forall a. Eq a => (a -> a) -> a -> a
limit Relation a -> Relation a
addGen Relation a
rel
               where
               addGen :: Relation a -> Relation a
addGen Relation a
rel' = Relation a
rel' Relation a -> Relation a -> Relation a
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
compose Relation a
rel' Relation a
rel

-- Finding a limit of a function.

limit             :: Eq a => (a -> a) -> a -> a
limit :: forall a. Eq a => (a -> a) -> a -> a
limit a -> a
f a
xs 
  | a
xs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
next          = a
xs
  | Bool
otherwise       = (a -> a) -> a -> a
forall a. Eq a => (a -> a) -> a -> a
limit a -> a
f a
next
    where
    next :: a
next = a -> a
f a
xs

-- Graphs                               
-- ^^^^^^ 
--  
-- The connected components of a graph.              

connect :: Ord a => Relation a -> Relation a

connect :: forall a. Ord a => Relation a -> Relation a
connect Relation a
rel = Relation a
clos Relation a -> Relation a -> Relation a
forall a. Ord a => Set a -> Set a -> Set a
`inter` Relation a
solc
              where
              clos :: Relation a
clos = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
tClosure Relation a
rel
              solc :: Relation a
solc = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
inverse Relation a
clos
--  
-- The inverse of a relation  swap all pairs.            

inverse :: Ord a => Relation a -> Relation a

inverse :: forall a. Ord a => Relation a -> Relation a
inverse = ((a, a) -> (a, a)) -> Set (a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (a, a) -> (a, a)
forall {b} {a}. (b, a) -> (a, b)
swap
          where 
          swap :: (b, a) -> (a, b)
swap (b
x,a
y) = (a
y,b
x)
--  
-- The equivalence classes of a(n equivalence) relation.        
--  
classes :: Ord a => Relation a -> Set (Set a)

classes :: forall a. Ord a => Relation a -> Set (Set a)
classes Relation a
rel 
  = (Set (Set a) -> Set (Set a)) -> Set (Set a) -> Set (Set a)
forall a. Eq a => (a -> a) -> a -> a
limit (Relation a -> Set (Set a) -> Set (Set a)
forall a. Ord a => Relation a -> Set (Set a) -> Set (Set a)
addImages Relation a
rel) Set (Set a)
start
    where
    start :: Set (Set a)
start = (a -> Set a) -> Set a -> Set (Set a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet a -> Set a
forall a. a -> Set a
sing (Relation a -> Set a
forall a. Ord a => Relation a -> Set a
eles Relation a
rel)

-- The auxiliary functions used in classes.         
--  
eles :: Ord a => Relation a -> Set a

eles :: forall a. Ord a => Relation a -> Set a
eles Relation a
rel = ((a, a) -> a) -> Relation a -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (a, a) -> a
forall a b. (a, b) -> a
fst Relation a
rel Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`union` ((a, a) -> a) -> Relation a -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (a, a) -> a
forall a b. (a, b) -> b
snd Relation a
rel

addImages :: Ord a => Relation a -> Set (Set a) -> Set (Set a)

addImages :: forall a. Ord a => Relation a -> Set (Set a) -> Set (Set a)
addImages Relation a
rel = (Set a -> Set a) -> Set (Set a) -> Set (Set a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet (Relation a -> Set a -> Set a
forall a. Ord a => Relation a -> Set a -> Set a
addImage Relation a
rel)


-- Searching in graphs                      
-- ^^^^^^^^^^^^^^^^^^^
--  
-- The descendants v under rel which lie outside st.        
--  
newDescs :: Ord a => Relation a -> Set a -> a -> Set a
newDescs :: forall a. Ord a => Relation a -> Set a -> a -> Set a
newDescs Relation a
rel Set a
st a
v = Relation a -> a -> Set a
forall a. Ord a => Relation a -> a -> Set a
image Relation a
rel a
v Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`diff` Set a
st
--  
-- Breaking the abstraction barrier for sets.            

-- defined in Sets.hs
-- flatten :: Ord a => Set a -> [a]

-- Under the list implementation, we can use            
--  flatten = id
                        
--  
-- A list of new descendants.                   
--  
findDescs :: Ord a => Relation a -> [a] -> a -> [a]
findDescs :: forall a. Ord a => Relation a -> [a] -> a -> [a]
findDescs Relation a
rel [a]
xs a
v = Set a -> [a]
forall {a}. Set a -> [a]
flatten (Relation a -> Set a -> a -> Set a
forall a. Ord a => Relation a -> Set a -> a -> Set a
newDescs Relation a
rel ([a] -> Set a
forall a. Ord a => [a] -> Set a
makeSet [a]
xs) a
v)


--  
-- Breadth first search.                        
-- ^^^^^^^^^^^^^^^^^^^^^

breadthFirst :: Ord a => Relation a -> a -> [a]

breadthFirst :: forall a. Ord a => Relation a -> a -> [a]
breadthFirst Relation a
rel a
val
    = ([a] -> [a]) -> [a] -> [a]
forall a. Eq a => (a -> a) -> a -> a
limit [a] -> [a]
step [a]
start
      where
      start :: [a]
start = [a
val]
      step :: [a] -> [a]
step [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Relation a -> [a] -> a -> [a]
forall a. Ord a => Relation a -> [a] -> a -> [a]
findDescs Relation a
rel [a]
xs) [a]
xs))

--  
-- Depth first search.                      
-- ^^^^^^^^^^^^^^^^^^^^^

depthFirst :: Ord a => Relation a -> a -> [a]

depthSearch :: Ord a => Relation a -> a -> [a] -> [a]

depthFirst :: forall a. Ord a => Relation a -> a -> [a]
depthFirst Relation a
rel a
v = Relation a -> a -> [a] -> [a]
forall a. Ord a => Relation a -> a -> [a] -> [a]
depthSearch Relation a
rel a
v []

depthSearch :: forall a. Ord a => Relation a -> a -> [a] -> [a]
depthSearch Relation a
rel a
v [a]
used
    = a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Relation a -> [a] -> [a] -> [a]
forall a. Ord a => Relation a -> [a] -> [a] -> [a]
depthList Relation a
rel (Relation a -> [a] -> a -> [a]
forall a. Ord a => Relation a -> [a] -> a -> [a]
findDescs Relation a
rel [a]
used' a
v) [a]
used'
      where
      used' :: [a]
used' = a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
used

depthList :: Ord a => Relation a -> [a] -> [a] -> [a]

depthList :: forall a. Ord a => Relation a -> [a] -> [a] -> [a]
depthList Relation a
rel [] [a]
used = [] 

depthList Relation a
rel (a
val:[a]
rest) [a]
used
  = [a]
next [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Relation a -> [a] -> [a] -> [a]
forall a. Ord a => Relation a -> [a] -> [a] -> [a]
depthList Relation a
rel [a]
rest ([a]
used[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
next)
    where
    next :: [a]
next 
      | a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
val [a]
used    = []
      | Bool
otherwise    = Relation a -> a -> [a] -> [a]
forall a. Ord a => Relation a -> a -> [a] -> [a]
depthSearch Relation a
rel a
val [a]
used

--  
-- From the exercises...                        
--  
-- distance :: Eq a => Relation a -> a -> a -> Int