Question

我编写了以下代码来使用FGL包递增图形给定边的标签，如果边不存在，则在递增之前创建它：

import Data.Graph.Inductive    

incrementEdge :: Edge -> Gr a Int -> Gr a Int
incrementEdge edge g = gmap (increment edge) g 

increment :: Edge -> Context a Int -> Context a Int
increment (a,b) all@(p,n,x,v) = if a /= n then all else (p,n,x,v'')
  where
    v' = let (r,_) = elemNode b v in if r then v else ((0,b):v)
    v'' = map (\(x,y) -> if y == b then (x+1,y) else (x,y)) v'

a :: Gr String Int
a = ([],1,"a",[]) & empty
b = ([],2,"b",[]) & a

在测试时我得到了以下结果：

*Main> incrementEdge (1,1) b

1:"a"->[(1,1)]
2:"b"->[]
*Main> incrementEdge (1,2) b

1:"a"->[(1,2)]
2:"b"->[]
*Main> incrementEdge (2,2) b

1:"a"->[]
2:"b"->[(1,2)]

但是......

*Main> incrementEdge (2,1) b
*** Exception: Edge Exception, Node: 1

这里有什么问题？

版

elemNode ys [] = (False,0)
elemNode ys ((m,xs):xss) = if ys == xs then (True,m) else elemNode ys xss

我想编写一个函数，它将从两个节点标签向图形添加边缘，该函数检查两个节点是否存在，如果不存在则创建它们： - 如果节点已经存在，则它们之间的边缘标签是递增的， - 如果这些节点之间没有边缘，则在增加之前创建它

感谢您的回复

Answer 1

我认为您不应该使用gmap添加边：它会以任意顺序折叠图中的所有上下文，并通过&新建一个新图形背景在一起。如果新上下文具有指向尚未&的节点的链接，则会获得Edge Exception。

这是一个简单的例子：

*Main> ([], 1, "a", [(0, 2)]) & empty :: Gr String Int
*** Exception: Edge Exception, Node: 2

我只使用FGL进行了几个小项目，我当然不是专家，但使用{{1}添加新边（带标签1）可能更有意义然后在需要时进行所有计数：

insEdge

这似乎符合要求：

import Data.Graph.Inductive
import qualified Data.IntMap as I

incrementEdge :: Edge -> Gr a Int -> Gr a Int
incrementEdge (a, b) = insEdge (a, b, 1)

count :: Gr a Int -> Gr a Int
count = gmap $ \(p, n, x, v) -> (countAdj p, n, x, countAdj v)
  where
    swap (a, b) = (b, a)
    countAdj = map swap . I.toList . I.fromListWith (+) . map swap

Answer 2

1）grep包中的Edge Exception快速fgl：

cabal unpack fgl
cd fgl*
grep "Edge Exception" * -R

生成文件Data/Graph/Inductive/Tree.hs。在那里我们有调用updAdj，它会在elemFM g v为假的任何时候抛出此异常。

2）你能提供可运行的代码吗？您发布的内容缺少elemNode（使用fgl 5.4.2.3时）

3）你能提供你正在使用的fgl版本吗？如果它已经过时，升级可能会解决问题。

Answer 3

图表上的映射似乎不是正确的遍历。以下内容适用于边缘源节点的提取上下文。

edgeLookup :: Node -> [(a,Node)] -> Maybe ((a,Node), [(a,Node)])
edgeLookup n = aux . break ((== n) . snd)
    where aux (h, []) = Nothing
          aux (h, t:ts) = Just (t, h ++ ts)

incrementEdge :: Edge -> Gr a Int -> Maybe (Gr a Int)
incrementEdge (from,to) g = aux $ match from g
    where aux (Nothing, _) = Nothing
          aux (Just (i,n,l,o), g') = Just $ (i,n,l,checkEdge o) & g'
          checkEdge outEdges = 
              maybe ((1,to):outEdges) incEdge $ edgeLookup to outEdges
          incEdge ((cnt,n), rst) = (cnt+1,n):rst

我可能还会使用帮助器从(Maybe a, b) -> Maybe (a,b)然后fmap aux转到由match组成的帮助程序。这有助于将事情提炼得更好。

修改

为了支持基于标签的节点添加，需要跟踪标签和节点标识符（Ints）之间的双射。这可以通过使用与图表并行更新的Map来完成。

import Data.Graph.Inductive
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromJust)

-- A graph with uniquely labeled nodes.
type LGraph a b = (Map a Int, Gr a b)

-- Ensure that a node with the given label is present in the given
-- 'LGraph'. Return the Node identifier for the node, and a graph that
-- includes the node.
addNode :: Ord a => a -> LGraph a b -> (Int, LGraph a b)
addNode label (m,g) = aux $ M.lookup label m
    where aux (Just nid) = (nid, (m,g))
          aux Nothing    = (nid', (m', g'))
          [nid'] = newNodes 1 g 
          m' = M.insert label nid' m
          g' = insNode (nid', label) g

-- Adding a context to a graph requires updating the label map.
(&^) :: Ord a => Context a b -> LGraph a b -> LGraph a b
c@(_, n, label, _) &^ (m,g) = (m', g')
    where m' = M.insert label n m
          g' = c & g

-- Look for a particular 'Node' in an edge list.
edgeLookup :: Node -> [(a,Node)] -> Maybe ((a,Node), [(a,Node)])
edgeLookup n = aux . break ((== n) . snd)
    where aux (h, []) = Nothing
          aux (h, t:ts) = Just (t, h ++ ts)

-- Increment the edge between two nodes; create a new edge if needed.
incrementEdge :: Edge -> Gr a Int -> Maybe (Gr a Int)
incrementEdge (from,to) g = fmap aux $ liftMaybe (match from g)
    where aux ((i,n,l,o), g') = (i,n,l,checkEdge o) & g'
          checkEdge outEdges = 
              maybe ((1,to):outEdges) incEdge $ edgeLookup to outEdges
          incEdge ((cnt,n), rst) = (cnt+1,n):rst

liftMaybe :: (Maybe a, b) -> Maybe (a, b)
liftMaybe (Nothing, _) = Nothing
liftMaybe (Just x, y) = Just (x, y)

-- Increment an edge in an 'LGraph'. If the nodes are not part of the 
-- graph, add them.
incrementLEdge :: Ord a => (a, a) -> LGraph a Int -> LGraph a Int
incrementLEdge (from,to) g = (m', fromJust $ incrementEdge' (from',to') g')
    where (from', gTmp)  = addNode from g
          (to', (m',g')) = addNode to gTmp

-- Example
a' :: LGraph String Int
a' = ([],1,"a",[]) &^ (M.empty, empty)
b' = ([],2,"b",[]) &^ a'
test6 = incrementLEdge ("c","b") $ incrementLEdge ("b","a") b'

{-
*Main> test6
(fromList [("a",1),("b",2),("c",3)],
1:"a"->[]
2:"b"->[(1,1)]
3:"c"->[(1,2)])
-}

在Haskell包fgl中修改边缘标签

3 个答案: