美文网首页Haskell
[Haskell] 图的表示方法:邻接矩阵

[Haskell] 图的表示方法:邻接矩阵

作者: 何幻 | 来源:发表于2017-03-27 10:37 被阅读48次

1. 图的表示

import Data.Array
import Data.Ix

-- adjacency matrix representation
type Graph n w = Array (n, n) (Maybe w)

mkGraph :: (Ix n, Num w) => Bool -> (n, n) -> [(n, n, w)] -> (Graph n w)
mkGraph dir bnds@(l, u) es =
    emptyArray // ([((x1, x2), Just w) | (x1, x2, w) <- es] ++ 
                   if dir then []
                   else [((x2, x1), Just w) | (x1, x2, w) <- es, x1 /= x2])
    where emptyArray = 
              array ((l, l), (u, u)) 
              [((x1, x2), Nothing) | x1 <- range bnds, x2 <- range bnds]

adjacent g v1 = [v2 | v2 <- nodes g, (g!(v1, v2)) /= Nothing]

nodes g = range (l, u)
    where ((l, _), (u, _)) = bounds g

edgeIn g (x, y) = (g!(x, y)) /= Nothing

weight x y g = w
    where (Just w) = g!(x, y)

edgesD g = [(v1, v2, unwrap $ g!(v1, v2)) | 
               v1 <- nodes g, 
               v2 <- nodes g, 
               edgeIn g (v1, v2)]
    where unwrap (Just w) = w

edgesU g = [(v1, v2, unwrap $ g!(v1, v2)) | 
               v1 <- nodes g, 
               v2 <- range (v1, u), 
               edgeIn g (v1, v2)]
    where (_, (u, _)) = bounds g
          unwrap (Just w) = w

2. 用例

testGraph = mkGraph False (1, 5) 
                  [(1, 2, 12), (1, 3, 34), (1, 5, 78),
                   (2, 4, 55), (2, 5, 32), (3, 4, 61),
                   (3, 5, 44), (4, 5, 93)]
                   
testAdjacent = adjacent testGraph 1
-- [2,3,5]

testNodes = nodes testGraph 
-- [1,2,3,4,5]

testEdgeIn = edgeIn testGraph (1, 2)
-- True

testWeight = weight 1 2 testGraph
-- 12

testEdgesD = edgesD testGraph
-- [(1,2,12),(1,3,34),(1,5,78),(2,1,12),(2,4,55),(2,5,32),(3,1,34),(3,4,61),(3,5,44),(4,2,55),(4,3,61),(4,5,93),(5,1,78),(5,2,32),(5,3,44),(5,4,93)]

testEdgesU = edgesU testGraph
-- [(1,2,12),(1,3,34),(1,5,78),(2,4,55),(2,5,32),(3,4,61),(3,5,44),(4,5,93)]

参考

Algorithms: A Functional Programming Approach

相关文章

网友评论

    本文标题:[Haskell] 图的表示方法:邻接矩阵

    本文链接:https://www.haomeiwen.com/subject/flglottx.html