fregel-1.2.0: haskell/Graphs.hs

module Graphs where

import Fregel

-- make a graph

type VertexData a = (Vid, a)
type EdgeData b = (Vid, Vid, b)

mG :: [VertexData a] -> [EdgeData b] -> Bool -> Graph a b
mG vds eds True = toGraph vds (eds ++ flipEdgeList eds)
mG vds eds False = toGraph vds eds

flipEdgeList :: [EdgeData b] -> [EdgeData b]
flipEdgeList eds = [(d,s,b) | (s,d,b) <- eds]

toGraph :: [VertexData a] -> [EdgeData b] -> Graph a b
toGraph vds eds = gs
  where gs = [V vid a (inEdges vid) (outEdges vid) gs | (vid,a) <- vds]
        inEdges vid = [(b, gs !! (s-1)) | (s,d,b) <- eds, d == vid]
        outEdges vid = [(b, gs !! (d-1)) | (s,d,b) <- eds, s == vid]

valG :: Graph a b -> [(Vid, a)]
valG = map (\(V vid a _ _ _) -> (vid, a))

{-------------------------- Sample graphs ------------------------------}

{-
graph1:

     B <- A <-+
     |        |
     +------> C ----> D <-+
              |       |   |
              +-> E <-+   |
                  |       |
                  +-> F --+
-}

graph1 :: Graph String Int
graph1 = let va = V 1 "A" [(1, vc)] [(1, vb)] g
             vb = V 2 "B" [(1, va)] [(1, vc)] g
             vc = V 3 "C" [(1, vb)] [(1, va), (1, vd), (1, ve)] g
             vd = V 4 "D" [(1, vc), (1, vf)] [(1, ve)] g
             ve = V 5 "E" [(1, vc), (1, vd)] [(1, vf)] g
             vf = V 6 "F" [(1, ve)] [(1, vd)] g
             g = [va, vb, vc, vd, ve, vf]
         in g

{-
graph1n:
       -1    3
     B <- A <-+ 
     |        |  3       3
     +------> C ----> D <-+
      -1      |       |   |
              +-> E <-+   |
              1   |   -3  |
                 1+-> F --+

the Dijkstra algorithm (from A) fails: 
  it says cost(A,F) = 0 but this should be -1
-}

-- with negative edge
graph1n :: Graph String Int
graph1n = let va = V 1 "A" [(3, vc)] [(-1, vb)] g
              vb = V 2 "B" [(-1, va)] [(-1, vc)] g
              vc = V 3 "C" [(-1, vb)] [(3, va), (3, vd), (1, ve)] g
              vd = V 4 "D" [(3, vc), (3, vf)] [(-3, ve)] g
              ve = V 5 "E" [(1, vc), (-3, vd)] [(1, vf)] g
              vf = V 6 "F" [(1, ve)] [(3, vd)] g
              g = [va, vb, vc, vd, ve, vf] 
          in g

graph2 :: Graph Int Int
graph2 = mG [(1, 100), (2, 600), (3, 200), (4, 400), (5, 500), (6, 300)]
            [(1,2,1),(2,3,1),(3,1,1),(3,4,1),(3,5,1),(4,5,1),(5,6,1),(6,4,1)]
            True

graph3 :: Graph String Int
graph3 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F")]
            [(1,2,6),(1,3,4),(1,4,1),(2,1,6),(2,6,3),(3,2,1),(3,5,5),
             (4,3,2),(4,5,3),(5,6,6)]
            False

{-
graph4 (undirected (bi-directional)):

     A -- C -- B   
          |            
          |   +--- E ------+ 
          |   |    |       | 
          +-- D -- F -- H  |
              |    |       |
              +--- G ------+

   D,E,F,G forms a 4-clique  ->  the densest subgraph.

-}

graph4 :: Graph String Int
graph4 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F"),(7,"G"),(8,"H")]
            [(1,3,1),(2,3,1),(3,4,1),(4,5,1),(4,6,1),
             (4,7,1),(5,6,1),(5,7,1),(6,7,1),(6,8,1)]
            True

graph4' :: Graph Int Int
graph4' = mG [(1,10),(2,11),(3,12),(4,13),(5,14),(6,15),(7,16),(8,17)]
             [(1,3,1),(2,3,1),(3,4,1),(4,5,1),(4,6,1),
              (4,7,1),(5,6,1),(5,7,1),(6,7,1),(6,8,1)]
             True
{-
graph5:

    A <-> B            E <-> F            I <-> J 
          |            |     |            |
          +-> C <-> D <-     +-> G <-> H <-


-}

graph5 :: Graph String Int
graph5 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F"),(7,"G"),(8,"H"),
             (9,"I"),(10,"J")]
            [(1,2,1),(2,1,1),(2,3,1),(3,4,1),(4,3,1),(5,4,1),(5,6,1),(6,5,1),
             (6,7,1),(7,8,1),(8,7,1),(9,8,1),(9,10,1),(10,9,1)]
            False