Graph.hs

module Graph ( Graph, Node, Edge,
               emptyGraph, nodes, node, label,
               insertNode, deleteNode, insertEdge, deleteEdge,
               outEdges ) where

--------------------------------------------------------------------------------
-- I N T E R F A C E  :  P U B L I C
--------------------------------------------------------------------------------

-- Graph : a weighted directed graph

--------------------------------------------------------------------------------

-- Node : a node ( a member of "Eq" and "Ord" )

--------------------------------------------------------------------------------

-- Edge : an edge

type Edge = ( Node, Node, Float )  -- ( start, end, weight )

--------------------------------------------------------------------------------

-- emptyGraph : the empty graph

emptyGraph :: Graph

--------------------------------------------------------------------------------

-- nodes g : a list of the nodes in graph 'g'

nodes :: Graph -> [ Node ]

--------------------------------------------------------------------------------

-- node s : a node with label 's'

node :: String -> Node

--------------------------------------------------------------------------------

-- label n : the label of node 'n'

label :: Node -> String

--------------------------------------------------------------------------------

-- insertNode n g : the graph formed by inserting node 'n' into graph 'g'

insertNode :: Node -> Graph -> Graph

--------------------------------------------------------------------------------

-- deleteNode n g : the graph formed by deleting node 'n' from graph 'g'

deleteNode :: Node -> Graph -> Graph

--------------------------------------------------------------------------------

-- insertEdge e g : the graph formed by inserting edge 'e' into graph 'g'

insertEdge :: Edge -> Graph -> Graph

--------------------------------------------------------------------------------

-- deleteEdge e g : the graph formed by deleting edge 'e' from graph 'g'

deleteEdge :: Edge -> Graph -> Graph

--------------------------------------------------------------------------------

-- outEdges n g : a list of the edges starting from node 'n' in graph 'g'

outEdges :: Node -> Graph -> [ Edge ]

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- I M P L E M E N T A T I O N  :  P R I V A T E
--------------------------------------------------------------------------------

data Node = N String deriving (Eq, Show)

-------------------------------------------------------------------------------

data Graph =  G [ ( Node, [ Edge ] ) ] deriving (Eq, Show)

-------------------------------------------------------------------------------

emptyGraph = G []

--------------------------------------------------------------------------------

nodes (G g) = map fst g

--------------------------------------------------------------------------------

node s = N s

--------------------------------------------------------------------------------

label (N s) = s

--------------------------------------------------------------------------------

insertNode n (G g) 
    | elem n $ nodes (G g) = error "Node already exists."
    | otherwise            = G $ g ++ [(n, [])]

--------------------------------------------------------------------------------

deleteNode n (G g) 
    | null g                  = error "Graph is empty."
    | notElem n $ nodes $ G g = error "Node doesn't exist."
    | otherwise               = G $ deleteNode' n g

deleteNode' :: Node -> [(Node,[Edge])] -> [(Node,[Edge])]
deleteNode' n = foldr ( \(n1,es) cur -> if n1 == n then cur else 
                      ( n1, ( filter ( \(_,n2,_) -> n2 /= n) es )) : cur ) [] 

--------------------------------------------------------------------------------

insertEdge (n1,n2,w) (G g)
    | null g                   = error "Graph is empty."
    | notElem n1 $ nodes $ G g = error "Start node doesn't exist."
    | notElem n2 $ nodes $ G g = error "End node doesn't exist."
    | otherwise                = G $ insertEdge' (n1,n2,w) g 


insertEdge' :: Edge -> [(Node,[Edge])] -> [(Node,[Edge])]
insertEdge' (n1,n2,w) ((n,es):g)
    | n1 == n   = (n,((n1,n2,w):es)) : g
    | otherwise = (n,es) : insertEdge' (n1,n2,w) g

--------------------------------------------------------------------------------

deleteEdge (n1,n2,w) (G g)
    | null g                          = error "Graph is empty."
    | notElem n1 $ nodes $ G g        = error "Start node doesn't exist."
    | notElem n2 $ nodes $ G g        = error "End node doesn't exist."
    | notElem (n1,n2,w) $ edges $ G g = error "Edge doesn't exist."    
    | otherwise = G [ ((fst g'), (deleteEdge' (n1,n2,w) (snd g'))) | g' <- g ]

deleteEdge' :: Edge -> [Edge] -> [Edge]
deleteEdge' _ [] = []
deleteEdge' (n1,n2,w) ((n1',n2',w'): es) 
    | n1 == n1' && n2 == n2' && w == w' = es
    | otherwise = (n1',n2',w') : (deleteEdge' (n1,n2,w) es)

edges :: Graph -> [ Edge ]
edges (G g) = concat (map snd g)

--------------------------------------------------------------------------------

outEdges _ (G []) = error "Graph is empty."
outEdges n (G ( g:gs )) 
    | notElem n $ nodes $ G $ g:gs = error "Node doesn't exist."
    | n == fst g                   = snd g 
    | otherwise                    = outEdges n $ G gs

--------------------------------------------------------------------------------

n1 = node "a"
n2 = node "b"
n3 = node "c"
n4 = node "d"
e1 = (n1, n2, 3.3)
e2 = (n2, n3, 4)
e3 = (n2, n1, 7)
e4 = (n3, n1, 6)
e5 = (n4, n1, 2)
e6 = (n1, n4, 1)
testGraph = foldr insertEdge (foldr insertNode emptyGraph [n1, n2, n3]) [e1, e2, e3]

t1 = testGraph
ex1 = G [  
            (N "c",[]),
            (N "b",[(N "b",N "c",4.0),(N "b",N "a",7.0)]),
            (N "a",[(N "a",N "b",3.3)]) 
        ]

t2 = insertNode n4 testGraph
ex2 = G [  
            (N "c",[]),
            (N "b",[(N "b",N "c",4.0),(N "b",N "a",7.0)]),
            (N "a",[(N "a",N "b",3.3)]),
            (N "d",[])
        ]

t3 = insertNode n1 testGraph
ex3 = error "Node already exists."


t5 = insertEdge e4 emptyGraph
t6 = insertEdge e5 testGraph
t7 = insertEdge e6 testGraph
t8 = deleteEdge e1 emptyGraph
t9 = deleteEdge e1 testGraph
ex9 = G [
            (N "c",[]),
            (N "b",[(N "b",N "c",4.0),(N "b",N "a",7.0)]),
            (N "a",[])
        ]
t10 = deleteEdge e4 testGraph
t11 = deleteEdge e5 testGraph
t12 = deleteEdge e6 testGraph
t13 = deleteNode n1 testGraph
ex13 = [  
            (N "c",[]),
            (N "b",[(N "b",N "c",4.0)])
       ]
t14 = deleteNode n1 emptyGraph
t15 = deleteNode n4 testGraph

--------------------------------------------------------------------------------