SimpleGraph.hs

Dateiinhalt

-- {-# LANGUAGE FlexibleInstances #-}
module SimpleGraph where

import Data.Char
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map

data SimpleGraph a =
   SimpleGraph {
      nodes :: Set a,
      succs :: Map a (Set a),
      preds :: Map a (Set a)
   }


-- Convert the graph to dot representation. The result can be opened
-- with dotty (<code>dotty output.dot</code>) or converted to PDF
-- with dot (<code>dot -Tpdf output.dot > output.pdf</code>).
-- See: http://www.graphviz.com
instance (Ord a, Show a) => Show (SimpleGraph a) where
  show = showSimpleGraph ""

showSimpleGraph name g = unlines $
    ["graph " ++ name ++ " {"] ++ ns ++ es ++ ["}"]
    where ns = map showAlphaNum $ Set.toAscList $ nodes g
          es = map show $ Set.toAscList $ edgeSet g

edgeSet :: (Eq a, Ord a) => SimpleGraph a -> Set (Edge a)
edgeSet g = Set.fromList $ ss ++ ps
  where
     ss = Map.assocs (succs g) >>= \ (k, vs) -> map (edge k) $ Set.toAscList vs
     ps = Map.assocs (preds g) >>= \ (k, vs) -> map (flip edge k) $ Set.toAscList vs

data Edge a = Edge a a
  deriving (Eq, Ord)

edge a b = Edge (min a b) (max a b)

instance Show a => Show (Edge a) where
  show (Edge a b) = showAlphaNum a ++ " -- " ++ showAlphaNum b

showAlphaNum :: Show a => a -> String
showAlphaNum = filter isAlphaNum . show

successors :: (Ord a) => SimpleGraph a -> a -> Set a
successors g x = Map.findWithDefault Set.empty x (succs g)

predecessors :: (Ord a) => SimpleGraph a -> a -> Set a
predecessors g x = Map.findWithDefault Set.empty x (preds g)

neighbours :: (Ord a) => SimpleGraph a -> a -> Set a
neighbours g x = (successors g x) `Set.union` (predecessors g x)

inDegree :: (Ord a) => SimpleGraph a -> a -> Int
inDegree g x = Set.size $ predecessors g x

outDegree :: (Ord a) => SimpleGraph a -> a -> Int
outDegree g x = Set.size $ successors g x

degree :: (Ord a) => SimpleGraph a -> a -> Int
degree g x = (inDegree g x) + (outDegree g x)

emptyGraph :: SimpleGraph a
emptyGraph = SimpleGraph { nodes = Set.empty, succs = Map.empty, preds = Map.empty }

addNode :: (Ord a) => SimpleGraph a -> a -> SimpleGraph a
addNode g x = g { nodes = Set.insert x (nodes g) }

addEdge :: (Ord a) => SimpleGraph a -> a -> a -> SimpleGraph a
addEdge g src dst =
   g { succs = Map.insertWith Set.union src (Set.singleton dst) (succs g)
     , preds = Map.insertWith Set.union dst (Set.singleton src) (preds g) }