如何编写CLIPS程序检测无向图中的直接与间接连接?
CLIPS程序检测无向图直接与间接连接的实现方案
一、问题背景
我们有3组节点对应无向图的3个独立集合:
Set-A = {1, 2, 3, 4, 5} Set-B = {6, 7, 8, 9, 10} Set-C = {11, 12, 13, 14, 15}
图中的边分为两类:
- ss-pairs:同一集合内的节点连接(集合内边)
- ts-pairs:不同集合间的节点连接(集合间边)
原始图的边数据如下:
ss-pairs = [(1, 2), (2, 3), (3, 4), (4, 5), (6, 7), (7, 8), (8, 9), (9, 10), (11, 12), (12, 13), (13, 14), (14, 15)] ts-pairs = [(1, 6), (2, 7), (3, 8), (4, 9), (6, 11), (7, 12), (8, 13), (9, 14)]
对图操作后会生成移除特定集合节点的生成树(ST),例如移除Set-B的节点7后,某生成树整理后的边数据为:
ss-pairs = [(1,2), (2,3), (3,4), (4,5), (8,9), (9,10), (11,12), (12,13), (13,14), (14,15)] ts-pairs = [(4,9), (6,11), (8,13)]
二、连接判定规则
1. 间接连接规则
当通过Set-A、Set-B、Set-C各一个节点形成连通路径,将三个集合全部连通时,判定为间接连接。具体满足以下任一条件:
- 某个Set-A节点与某个Set-B节点相连,且该Set-B节点同时与某个Set-C节点相连;
- 某个Set-A节点与某个Set-B节点相连,且存在另一个Set-B节点与某个Set-C节点相连,且这两个Set-B节点通过集合内边连通。
2. 直接连接规则
当一条集合间边仅连接两个集合,完全不涉及第三个集合时,判定为直接连接。具体满足以下任一条件:
- Set-A节点仅与Set-B节点相连,且该路径中没有Set-C节点参与(反之亦然);
- Set-C节点仅与Set-B节点相连,且该路径中没有Set-A节点参与(反之亦然)。
示例分析
以生成树的ts-pairs = [(4,9), (6,11), (8,13)]为例:
- 节点6、8、9属于Set-B(已移除节点7),节点4属于Set-A,节点11、13属于Set-C;
- 边(4,9)和(8,13)构成间接连接:4(A)-9(B)通过ss边连通8(B),8又连接13(C),形成A-B-C的连通路径;
- 边(6,11)为直接连接:6(B)仅与11(C)相连,且6未连通任何Set-A节点,不涉及第三个集合。
三、CLIPS程序实现方案
1. 事实模板定义
首先定义存储节点集合、边、移除节点的事实模板:
; 存储节点所属集合 (deftemplate node-set (slot node-id) (slot set-name) ; 取值:Set-A/Set-B/Set-C ) ; 存储边信息,区分集合内边(ss)和集合间边(ts) (deftemplate edge (slot type) ; 取值:ss/ts (slot node1) (slot node2) ) ; 存储被移除的节点 (deftemplate removed-node (slot node-id) ) ; 缓存节点集合信息,避免重复查询 (deftemplate node-set-info (slot node-id) (slot set-name) )
2. 加载初始数据
将生成树的边、节点集合、移除节点信息断言为CLIPS事实,示例如下:
; 断言所有节点的集合归属 (assert (node-set (node-id 1) (set-name Set-A))) (assert (node-set (node-id 2) (set-name Set-A))) (assert (node-set (node-id 3) (set-name Set-A))) (assert (node-set (node-id 4) (set-name Set-A))) (assert (node-set (node-id 5) (set-name Set-A))) (assert (node-set (node-id 6) (set-name Set-B))) (assert (node-set (node-id 8) (set-name Set-B))) (assert (node-set (node-id 9) (set-name Set-B))) (assert (node-set (node-id 10) (set-name Set-B))) (assert (node-set (node-id 11) (set-name Set-C))) (assert (node-set (node-id 12) (set-name Set-C))) (assert (node-set (node-id 13) (set-name Set-C))) (assert (node-set (node-id 14) (set-name Set-C))) (assert (node-set (node-id 15) (set-name Set-C))) ; 断言生成树中的ss边 (assert (edge (type ss) (node1 1) (node2 2))) (assert (edge (type ss) (node1 2) (node2 3))) (assert (edge (type ss) (node1 3) (node2 4))) (assert (edge (type ss) (node1 4) (node2 5))) (assert (edge (type ss) (node1 8) (node2 9))) (assert (edge (type ss) (node1 9) (node2 10))) (assert (edge (type ss) (node1 11) (node2 12))) (assert (edge (type ss) (node1 12) (node2 13))) (assert (edge (type ss) (node1 13) (node2 14))) (assert (edge (type ss) (node1 14) (node2 15))) ; 断言生成树中的ts边 (assert (edge (type ts) (node1 4) (node2 9))) (assert (edge (type ts) (node1 6) (node2 11))) (assert (edge (type ts) (node1 8) (node2 13))) ; 断言被移除的节点 (assert (removed-node (node-id 7)))
3. 辅助规则与函数
生成节点集合信息缓存
(defrule get-node-set ?n <- (node-set (node-id ?id) (set-name ?set)) (not (node-set-info (node-id ?id))) => (assert (node-set-info (node-id ?id) (set-name ?set))) )
判断两个节点是否连通(基于广度优先搜索)
(deffunction connected (?node1 ?node2) (if (= ?node1 ?node2) then (return TRUE)) (bind ?visited (create$)) (bind ?queue (create$ ?node1)) (while (not (empty$ ?queue)) do (bind ?current (first$ ?queue)) (bind ?queue (rest$ ?queue)) (if (member$ ?current ?visited) then (continue)) (bind ?visited (create$ ?visited ?current)) ; 遍历所有与当前节点相连的ss边 (do-for-all-facts ((?e edge)) (and (eq ?e:type ss) (or (eq ?e:node1 ?current) (eq ?e:node2 ?current))) (bind ?neighbor (if (eq ?e:node1 ?current) then ?e:node2 else ?e:node1)) (if (= ?neighbor ?node2) then (return TRUE)) (if (not (member$ ?neighbor ?visited)) then (bind ?queue (create$ ?queue ?neighbor)) ) ) ) (return FALSE) )
判断节点是否连通到目标集合
(deffunction connected-to-set (?node ?target-set) (bind ?visited (create$)) (bind ?queue (create$ ?node)) (while (not (empty$ ?queue)) do (bind ?current (first$ ?queue)) (bind ?queue (rest$ ?queue)) (if (member$ ?current ?visited) then (continue)) (bind ?visited (create$ ?visited ?current)) ; 检查当前节点是否属于目标集合 (do-for-all-facts ((?n node-set-info)) (eq ?n:node-id ?current) (if (eq ?n:set-name ?target-set) then (return TRUE)) ) ; 遍历所有与当前节点相连的边(ss和ts) (do-for-all-facts ((?e edge)) (or (eq ?e:node1 ?current) (eq ?e:node2 ?current)) (bind ?neighbor (if (eq ?e:node1 ?current) then ?e:node2 else ?e:node1)) (if (not (member$ ?neighbor ?visited)) then (bind ?queue (create$ ?queue ?neighbor)) ) ) ) (return FALSE) )
4. 核心检测规则
检测间接连接
(deftemplate indirect-connection (slot edge1) (slot edge2) (slot via-node) ) (defrule detect-indirect-connection ; 匹配A-B的ts边 ?e1 <- (edge (type ts) (node1 ?a) (node2 ?b1)) (node-set-info (node-id ?a) (set-name Set-A)) (node-set-info (node-id ?b1) (set-name Set-B)) ; 匹配B-C的ts边 ?e2 <- (edge (type ts) (node1 ?b2) (node2 ?c)) (node-set-info (node-id ?b2) (set-name Set-B)) (node-set-info (node-id ?c) (set-name Set-C)) ; 两个B节点连通 (test (connected ?b1 ?b2)) ; 避免重复标记 (not (indirect-connection (edge1 (list ?a ?b1)) (edge2 (list ?b2 ?c)))) (not (indirect-connection (edge1 (list ?b2 ?c)) (edge2 (list ?a ?b1)))) => (bind ?via (if (= ?b1 ?b2) then ?b1 else (list ?b1 ?b2))) (assert (indirect-connection (edge1 (list ?a ?b1)) (edge2 (list ?b2 ?c)) (via-node ?via))) (printout t "间接连接:边" (list ?a ?b1) "与边" (list ?b2 ?c) "通过B节点" ?via "连通三个集合。" crlf) )
检测直接连接
(deftemplate direct-connection (slot edge) (slot connection-type) ) ; 检测A-B直接连接 (defrule detect-direct-connection-ab ?e <- (edge (type ts) (node1 ?x) (node2 ?y)) ; 匹配A-B的ts边 (or (and (node-set-info (node-id ?x) (set-name Set-A)) (node-set-info (node-id ?y) (set-name Set-B))) (and (node-set-info (node-id ?x) (set-name Set-B)) (node-set-info (node-id ?y) (set-name Set-A)))) ; 获取A和B节点 (bind ?a-node (if (node-set-info (node-id ?x) (set-name Set-A)) then ?x else ?y)) (bind ?b-node (if (node-set-info (node-id ?x) (set-name Set-B)) then ?x else ?y)) ; 未连通到Set-C (not (connected-to-set ?a-node Set-C)) (not (connected-to-set ?b-node Set-C)) (not (direct-connection (edge (list ?x ?y)))) => (assert (direct-connection (edge (list ?x ?y)) (connection-type "A-B直接连接"))) (printout t "直接连接:边" (list ?x ?y) "为A-B直接连接,未涉及Set-C。" crlf) ) ; 检测B-C直接连接 (defrule detect-direct-connection-bc ?e <- (edge (type ts) (node1 ?x) (node2 ?y)) ; 匹配B-C的ts边 (or (and (node-set-info (node-id ?x) (set-name Set-B)) (node-set-info (node-id ?y) (set-name Set-C))) (and (node-set-info (node-id ?x) (set-name Set-C)) (node-set-info (node-id ?y) (set-name Set-B)))) ; 获取B和C节点 (bind ?b-node (if (node-set-info (node-id ?x) (set-name Set-B)) then ?x else ?y)) (bind ?c-node (if (node-set-info (node-id ?x) (set-name Set-C)) then ?x else ?y)) ; 未连通到Set-A (not (connected-to-set ?c-node Set-A)) (not (connected-to-set ?b-node Set-A)) (not (direct-connection (edge (list ?x ?y)))) => (assert (direct-connection (edge (list ?x ?y)) (connection-type "B-C直接连接"))) (printout t "直接连接:边" (list ?x ?y) "为B-C直接连接,未涉及Set-A。" crlf) )
5. 执行流程
- 加载所有事实模板和规则;
- 断言生成树的节点集合、边、移除节点事实;
- 运行
(run)命令触发所有规则,程序会自动生成节点集合缓存,检测并输出所有直接/间接连接。
内容的提问来源于stack exchange,提问作者Honoré De Marseille
相关产品推荐
相关产品推荐

