изменить метку края в пакете Haskell fgl

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

в чем здесь проблема?

EDITION

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

Я хочу написать функцию, которая добавит ребро в граф из меток двух узлов, функция проверяет, существуют ли два узла, если не создает их: - если узлы уже существуют, метка ребра между ними увеличивается, - если между этими узлами нет ребра, оно создается перед увеличением

Спасибо за ваш ответ

Answer 1

Я не думаю, что вы должны добавлять ребра с помощью gmap: он сгибается по всем контекстам в графе в произвольном порядке и создает новый граф, & объединяя новые контексты вместе.Если в новом контексте есть ссылка на или с узла, который еще не был & ed, вы получите Edge Exception.

Вот простой пример:

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

Я использовал FGL только для пары небольших проектов и, конечно, не являюсь экспертом, но, вероятно, имеет больше смысла просто добавлять новые ребра (с меткой 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

Кажется, это работает как нужно:

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

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

Answer 2

Отображение на графике не похоже на правильный путь обхода.Следующее работает с извлеченным контекстом исходного узла ребра.

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.Это помогло бы немного лучше разобраться.

EDIT

Чтобы поддерживать добавление узлов на основе меток, необходимо отслеживать биекцию между метками и идентификаторами узлов (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)])
-}

Answer 3

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 вы используете?Если оно устарело, обновление может решить эту проблему.