基于指令为Haskell fgl图库的边添加标签的实现方案

基础类型修正 #

你给出的Directive类型缺少节点标签的类型参数，补全后定义为：

data Directive a = Up (a -> Bool) | Down (a -> Bool)

其中a是节点标签的类型，Up表示沿前驱边向上遍历父节点，Down表示沿后继边向下遍历子节点，括号内为节点标签需要满足的过滤条件。

核心逻辑实现 #

1. 单步指令执行 #

首先实现单条指令的执行逻辑，给定当前节点和指令，返回所有符合过滤条件的下一跳节点：

import Data.Graph.Inductive.Graph
import Data.Maybe (mapMaybe)

step :: Graph gr => gr a b -> Node -> Directive a -> [Node]
step g curNode dir = case dir of
  -- 向上遍历前驱节点，过滤符合条件的节点
  Up pred -> filter (\n -> pred $ lab' $ context g n) (pre g curNode)
  -- 向下遍历后继节点，过滤符合条件的节点
  Down pred -> filter (\n -> pred $ lab' $ context g n) (suc g curNode)

2. 指令序列路径匹配 #

从根节点出发执行完整的指令序列，返回所有匹配的完整路径（路径顺序为[根节点, 第一步节点, 第二步节点...]）：

findPaths :: Graph gr => gr a b -> Node -> [Directive a] -> [[Node]]
findPaths _ start [] = [[start]]
findPaths g start (d:ds) = do
  nextNode <- step g start d
  restPath <- findPaths g nextNode ds
  return $ start : restPath

3. 规则转带标签边 #

每条规则对应一组指令序列和目标标签，从匹配的路径中取最后两个节点生成对应标签的边：

ruleToEdges :: Graph gr => gr a b -> Node -> ([Directive a], lbl) -> [LEdge lbl]
ruleToEdges g root (dirs, lbl) = mapMaybe pathToEdge (findPaths g root dirs)
  where
    pathToEdge path = case reverse path of
      -- 路径长度至少为2才能生成边，取最后两个节点作为边的两端
      end : prev : _ -> Just (prev, end, lbl)
      _ -> Nothing

4. 批量应用规则 #

把所有规则生成的边写入图，得到打标完成的新图：

applyRules :: DynGraph gr => gr a oldLbl -> Node -> [([Directive a], newLbl)] -> gr a newLbl
applyRules g root rules = mkGraph (labNodes g) allEdges
  where
    allEdges = concatMap (ruleToEdges g root) rules

示例验证 #

以你给出的祖父规则为例：

-- 假设节点标签为Person类型，有sex字段取性别
data Person = Person { name :: String, sex :: String } deriving (Eq, Show)

grandfatherRule :: ([Directive Person], String)
grandfatherRule = ([Up (\_ -> True), Up (\p -> sex p == "male")], "grandfather")

执行规则后，匹配到的路径为[根节点, 父节点, 祖父节点]，最后两个节点为父节点和祖父节点，生成边(父节点, 祖父节点, "grandfather")，完全符合相对根节点打标的需求。

关于gfold的补充说明 #

gfold是fgl提供的通用遍历函数，第一个参数是节点处理函数，输入当前节点的Context，返回下一层需要遍历的节点列表。你如果要基于gfold实现路径匹配也可以，但上面的递归实现更贴合指令序列执行逻辑，不需要额外适配gfold的接口。

内容的提问来源于stack exchange，提问作者phoxd