转载自：https://mp.weixin.qq.com/s/mGqpI81rdsxGyaz1K-l6jw
7、节点的度和图形着色
程序文件p6_07.pl:
1 :- ensure_loaded(p6_01). % conversions
2 :- ensure_loaded(p6_02). % adjacent/3
3
% a) 编写确定给定节点度数的谓词 degree(Graph,Node,Deg)
% degree(Graph,Node,Deg) :- Deg是图Graph中节点Node的度数。
% (graph-term, node, integer), (+,+,?).
4 degree(graph(Ns,Es),Node,Deg) :-
5 alist_gterm(graph,AList,graph(Ns,Es)),
6 member(n(Node,AdjList),AList), !,
7 length(AdjList,Deg).
8
行注释：
1. 载入图 练习1中的程序
2. 载入图 练习2中的程序
3. 空行
4. Deg是图Graph中节点Node的度数
5. 原子列表与图项互转
6. 项n(Node,AdjList)是列表AList的成员
7. 邻接列表AdjList的(长度)度数Deg
8. 空行
% b)编写一个谓词，该谓词生成根据递减度排序的图的所有节点的列表
% degree_sorted_nodes(Graph,Nodes) :- Nodes是图Graph的节点列表，按递减程度排序。
9 degree_sorted_nodes(graph(Ns,Es),DSNodes) :-
10 alist_gterm(graph,AList,graph(Ns,Es)),
11 predsort(compare_degree,AList,AListDegreeSorted),
12 reduce(AListDegreeSorted,DSNodes).
13
行注释:
9. DSNodes是图Graph的节点列表，按递减程度排序
10. 原子列表与图项互转
11. 内置谓词 将列表AList排序结果放入AListDegreeSorted
12. 降序
13.
14 compare_degree(Order,n(N1,AL1),n(N2,AL2)) :-
15 length(AL1,D1),
16 length(AL2,D2),
17 compare(Order,D2+N1,D1+N2).
18
行注释:
14.
15. AL1的度数D1
16. AL2的度数D2
17. Order是<，>或=之一，其含义很明显。
18.
% 注意: compare(Order,D2+N1,D1+N2) 根据递减程度对节点进行排序，但如果程度相等，则按字母顺序排序。!
19 reduce([],[]).
20 reduce([n(N,_)|Ns],[N|NsR]) :-
21 reduce(Ns,NsR).
22
行注释:
19. 终止条件
20. 遍历参数1，转为参数2
21. 继续递归
22. 空行
% c)使用Welch-Powell算法绘制图形的节点，以使相邻节点具有不同的颜色
23 paint(Graph,ColoredNodes) :-
24 degree_sorted_nodes(Graph,DSNs),
25 paint_nodes(Graph,DSNs,[],1,ColoredNodes).
26
行注释:
23. 着色Graph，结果放入ColoredNodes
24. 将Graph排序结果放入DSNs
25. 着色节点
26.
% paint_nodes(Graph,Ns,AccNodes,Color,ColoNodes) :- 用颜色编号Color或更高的颜色绘制其余节点Ns。 AccNodes是已经着色的节点集。在ColoNodes中返回结果。
%(graph-term,node-list,c-node-list,integer,c-node-list)
%(图形项，节点列表，颜色节点列表，整数，颜色节点列表）.
%(+,+,+,+,-)
27 paint_nodes(_,[],ColoNodes,_,ColoNodes) :-
18 !.
29 paint_nodes(Graph,Ns,AccNodes,Color,ColoNodes) :-
30 paint_nodes(Graph,Ns,Ns,AccNodes,Color,ColoNodes).
31
行注释:
27. 终止条件
28. 截断
29. 常用技巧
30. 体会参数2，参数3
31. 空行
% paint_nodes(Graph,DSNs,Ns,AccNodes,Color,ColoNodes) :- 如果可能，用固定的颜色数字Color在Ns中绘制节点。如果Ns为空，则继续下一个色号。 AccNodes是已经着色的节点集。在ColoNodes中返回结果。
%(graph-term,node-list,c-node-list,c-node-list,integer,c-node-list)
%(图形项，节点列表，颜色节点列表，颜色节点列表，整数，颜色节点列表)
%(+,+,+,+,+,-)
32 paint_nodes(Graph,Ns,[],AccNodes,Color,ColoNodes) :- !,
33 Color1 is Color+1,
34 paint_nodes(Graph,Ns,AccNodes,Color1,ColoNodes).
35 paint_nodes(Graph,DSNs,[N|Ns],AccNodes,Color,ColoNodes) :-
36 \+ has_neighbor(Graph,N,Color,AccNodes), !,
37 delete(DSNs,N,DSNs1),
38 paint_nodes(Graph,DSNs1,Ns,[c(N,Color)|AccNodes],Color,ColoNodes).
39 paint_nodes(Graph,DSNs,[_|Ns],AccNodes,Color,ColoNodes) :-
40 paint_nodes(Graph,DSNs,Ns,AccNodes,Color,ColoNodes).
41
行注释:
32. 此谓词终止条件
33. 换颜色
34. 继续递归前级(paint_nodes/5)谓词
35. 从参数3中取节点N和尾表Ns
36. 不相邻则截断
37. 删除列表DSNs中的节点N结果列表为DSNs1
38. 用DSNs1并且在参数4列表首增加项c(N,Color)继续递归
39. 取出参数3中列表的首元素
40. 继续递归
41.
42 has_neighbor(Graph,N,Color,AccNodes) :-
43 adjacent(N,X,Graph),
44 memberchk(c(X,Color),AccNodes).
45
行注释:
42. 确定N有相邻节点
43. 确定N与X相邻
44. 项c(X,Color)在AccNodes中
45.
测试:
?- human_gterm([b-c, f-c, g-h, d, f-b, k-f, h-g],G), paint_nodes(G,Ns,AccNodes,Color,ColoNodes).
G = graph([b, c, d, f, g, h, k], [e(b, c), e(b, f), e(c, f), e(f, k), e(g, h)]),
Ns = [],
AccNodes = ColoNodes.
为什么Ns = []?
8、深度优先顺序图遍历
% 写一个生成深度优先图遍历序列的谓词。应该指定起点，并且输出应该是从该起点可以到达的节点的列表（以深度优先）。
% 主要问题是，如果我们递归遍历该图，则必须以某种方式存储遇到的节点，以使它们在回溯步骤中不会消失。
% 在此解决方案中，我们使用“记录的数据库”，它是众所周知的断言/撤回(assert/retract)机制的更有效替代方法。有关详细信息，请参见SWI-Prolog手册。
程序文件p6_08.pl:
1 :- ensure_loaded(p6_01). % conversions
2 :- ensure_loaded(p6_02). % adjacent/3
3
4 depth_first_order(Graph,Start,Seq) :-
5 (Graph = graph(Ns,_),
6 !;
7 Graph = digraph(Ns,_)),
8 memberchk(Start,Ns),
9 clear_rdb(dfo),
10 recorda(dfo,Start),
11 (dfo(Graph,Start);
12 true),
13 bagof(X,recorded(dfo,X),Seq).
14
行注释:
1.
2.
3.
4.
5. 图的状况
6. 截断，或
7. 有向图的状况
8. 内部谓词
9. 清除记录
10. 开始记录
11. 无论成功与否
12. 全都为成功
13. 内部谓词
14.
15 dfo(Graph,X) :-
16 adjacent(X,Y,Graph),
17 \+ recorded(dfo,Y),
18 recordz(dfo,Y),
19 dfo(Graph,Y).
20
21 clear_rdb(Key) :-
22 recorded(Key,_,Ref),
23 erase(Ref),
24 fail.
25 clear_rdb(_).
行注释:
15.
16. X与Y邻接
17. 确定未被记录
18. 记录
19. 继续递归遍历
20. 空行
21.
22. 从数据库获取项，内部谓词
23. 清除变量Ref所指的子句，内部谓词
24. 强制失败，回溯
25.
8.a、深度优先顺序图遍历(替代解决方案)
% 写一个生成深度优先顺序图遍历序列的谓词。应该指定起点，并且输出应该是从该起点可以到达的节点的列表（以深度优先）。
% 主要问题是，如果我们递归遍历该图，则必须以某种方式存储遇到的节点，以使它们在回溯步骤中不会消失。
% 在此解决方案中，使用“记录的数据库”，它是众所周知的断言/撤回机制的更有效替代方法。有关详细信息，请参见SWI-Prolog手册。
% 使用邻接表的替代解决方案
程序文件p6_08a.pl:
1 :- ensure_loaded(p6_01). % conversions
2
3 depth_first_order(Graph,Start,Seq) :-
4 alist_gterm(_,Alist,Graph),
5 clear_rdb(dfo),
6 dfo(Alist,Start),
7 bagof(X,recorded(dfo,X),Seq).
8
行注释:
1.
2.
3.
4. 图项转为邻接表
5. 清除记录
6. 遍历邻接表
7.
8.
9 dfo(_,X) :-
10 recorded(dfo,X).
11 dfo(Alist,X) :-
12 \+ recorded(dfo,X),
13 recordz(dfo,X),
14 memberchk(n(X,AdjNodes),Alist),
15 Pred =.. [dfo,Alist], % 请参阅下面的备注
16 checklist(Pred,AdjNodes).
17
行注释:
9.
10. 判断记录存在否，内部谓词
11.
12. 如果记录不存在，内部谓词
13. 记录添加到子句的后面，内部谓词
14. 内部谓词
15. =..内置运算符
16.
17.
18 clear_rdb(Key) :-
19 recorded(Key,_,Ref),
20 erase(Ref),
21 fail.
22 clear_rdb(_).
行注释:
18.
19. 判断是否有记录，内部谓词
20. 清除记录，内部谓词
21. 强制失败回溯
22. 强制成功
% 首先，谓词Pred的构造和checklist/2预定义谓词的使用可能看起来很奇怪。它等效于以下构造：
% dfo(_,X) :- recorded(dfo,X).
% dfo(Alist,X) :-
% \+ recorded(dfo,X),
% recordz(dfo,X),
% memberchk(n(X,AdjNodes),Alist),
% dfo_list(Alist,AdjNodes).
%
% dfo_list(_,[]).
% dfo_list(Alist,[A|As]) :- dfo(Alist,A), dfo_list(Alist,As).
9、连接的组件
% 编写一个谓词，将一个图拆分为其相连的组件。
程序文件p6_09.pl:
1 :- ensure_loaded(p6_01). % conversions
2 :- ensure_loaded(p6_02). % path/4
3
% connected_components(G,Gs) :- Gs是图G的已连接组件的列表(仅用于图，不用于图！)
% (gterm, list-of-gterms), (+,-)
4 connected_components(graph([],[]),[]) :-
5 !.
6 connected_components(graph(Ns,Es),[graph(Ns1,Es1)|Gs]) :-
7 Ns = [N|_],
8 component(graph(Ns,Es),N,graph(Ns1,Es1)),
9 subtract(Ns,Ns1,NsR),
10 subgraph(graph(Ns,Es),graph(NsR,EsR)),
11 connected_components(graph(NsR,EsR),Gs).
12
行注释:
1.
2.
3.
4. 终止条件
5. 截断
6.
7. 从Ns中进一步解构出N
8. 图组件处理
9. 内部谓词,从Ns中删除Ns1中的所有元素。删除基于使用memberchk/2的合一。复杂度是|Ns1|*|Ns|。集合定义为无重复的无序列表。如果元素可以合一，则视为重复。
10. 参数2是参数1的子图
11. 继续递归
12.
13 component(graph(Ns,Es),N,graph(Ns1,Es1)) :-
14 Pred =..[is_path,graph(Ns,Es),N],
15 include(Pred,Ns,Ns1),
16 subgraph(graph(Ns,Es),graph(Ns1,Es1)).
17
18 is_path(Graph,A,B) :-
19 path(Graph,A,B,_).
20
行注释:
13.
14. 将Pred构建成项is_path(graph(Ns,Es),N)
15. 内部谓词,Pred成功的过滤器元素。如果Ns1包含成功call(Pred,Xi)的Ns的那些元素Xi，则为True。
16. graph(Ns1,Es1)是graph(Ns,Es)的子图
17. 空行
18. 在图Graph中存在A,B间的路径
19. 见程序文件p6_02.pl
20.
% subgraph(G,G1) :- G1是G的子图
21 subgraph(graph(Ns,Es),graph(Ns1,Es1)) :-
22 subset(Ns1,Ns),
23 Pred =.. [edge_is_compatible,Ns1],
24 sublist(Pred,Es,Es1).
25
行注释:
21.
22. Ns1是Ns的子集
23. 内置运算符，将Pred构建成项edge_is_compatible(Ns1)
24. 内部谓词
25.
26 edge_is_compatible(Ns1,Z) :-
27 (Z = e(X,Y),
28 !;
29 Z = e(X,Y,_)),
30 memberchk(X,Ns1),
31 memberchk(Y,Ns1).
26.
27. 解构Z
28. 如果e(X,Y)成功则截断
29. 或用e(X,Y,_)解构
30. X在列表Ns1中
31. 并且Y在列表Ns1中
9.a、连接的组件（替代解决方案）
% 编写一个谓词，将一个图拆分为其相连的组件。
1 :- ensure_loaded(p6_01). % conversions
2 :- ensure_loaded(p6_08). % depth_first_order/3
3
% connected_components(G,Gs) :- Gs是图G的已连接组件的列表（仅用于图，不用于有向图！）
% (gterm, list-of-gterms), (+,-)
4 connected_components(graph([],[]),[]) :-
5 !.
6 connected_components(graph(Ns,Es),[graph(Ns1,Es1)|Gs]) :-
7 Ns = [N|_],
8 component(graph(Ns,Es),N,graph(Ns1,Es1)),
9 subtract(Ns,Ns1,NsR),
10 subgraph(graph(Ns,Es),graph(NsR,EsR)),
11 connected_components(graph(NsR,EsR),Gs).
12
行注释:
1.
2.
3.
4. 终止条件
5. 截断
6.
7. 从Ns中进一步解构出N
8. 图组件处理
9. 内置谓词，内部谓词,从Ns中删除Ns1中的所有元素。删除基于使用memberchk/2的合一。复杂度是|Ns1|*|Ns|。集合定义为无重复的无序列表。如果元素可以合一，则视为重复。
10. graph(NsR,EsR)是graph(Ns,Es)的子图
11.
12.
13 component(graph(Ns,Es),N,graph(Ns1,Es1)) :-
14 depth_first_order(graph(Ns,Es),N,Seq),
15 sort(Seq,Ns1),
16 subgraph(graph(Ns,Es),graph(Ns1,Es1)).
17
行注释:
13.
14. 深度优先，程序文件p6_08.pl中的谓词
15. 排序
16. graph(Ns1,Es1)是graph(Ns,Es)的子图
17. 空行
% subgraph(G,G1) :- G1 is a subgraph of G
18 subgraph(graph(Ns,Es),graph(Ns1,Es1)) :-
19 subset(Ns1,Ns),
20 Pred =.. [edge_is_compatible,Ns1],
21 sublist(Pred,Es,Es1).
22
行注释:
18.
19. Ns1是Ns的子集
20. 内置运算符，将Pred构建成项edge_is_compatible(Ns1)
21. 内部谓词
22.
23 edge_is_compatible(Ns1,Z) :-
24 (Z = e(X,Y),
25 !;
26 Z = e(X,Y,_)),
27 memberchk(X,Ns1),
28 memberchk(Y,Ns1).
行注释:
23.
24. 解构Z
25. 如果e(X,Y)成功则截断
26. 或用e(X,Y,_)解构
27. X在列表Ns1中
28. 并且Y在列表Ns1中
图论的例子还有两个相应的代码注释试着自己来完成，完成后的结果可以发到邮箱：xiliman@yeah.net,同时也了解下各位的思维方式。谢谢！
10、二分图
% 写一个谓词，找出给定图是否为二分图。
1 :- ensure_loaded(p6_01). % conversions
2 :- ensure_loaded(p6_09). % connected_components/2
3
% is_bipartite(G) :- 图G是二分图
4 is_bipartite(G) :-
5 connected_components(G,Gs),
6 checklist(is_bi,Gs).
7
8 is_bi(graph(Ns,Es)) :- Ns = [N|_],
9 alist_gterm(_,Alist,graph(Ns,Es)),
10 paint(Alist,[],red,N).
11
行注释:
1.
2.
3.
4.
5. Gs是图G的已连接组件的列表
6. 看后面注释
7.
8.
9.
10.
11.
% paint(Alist,ColoredNodes,Color,ActualNode)
% (+,+,+,+)
12 paint(_,CNs,Color,N) :-
13 memberchk(c(N,Color),CNs), !.
14 paint(Alist,CNs,Color,N) :-
15 \+ memberchk(c(N,_),CNs),
16 other_color(Color,OtherColor),
17 memberchk(n(N,AdjNodes),Alist),
18 Pred =.. [paint,Alist,[c(N,Color)|CNs],OtherColor],
19 checklist(Pred,AdjNodes).
20
行注释:
12.
13.
14.
15.
16.
17.
18.
19.
20.
21 other_color(red,blue).
22 other_color(blue,red).
注释：
?- listing(checklist).
:- meta_predicate backward_compatibility:checklist(1,+).
backward_compatibility:checklist(Goal, List) :-
maplist(Goal, List).
true.
maplist是内置谓词
11、 生成具有N个节点的K-regular简单图。
% 在K-regular图中，所有节点的度数均为K。
% k_regular(K,N,Graph) :- 图是具有N个节点的K-regular简单图。
% 该图为图项形式。节点由数字标识 1..N.
% 可以通过回溯生成所有解决方案。
% (+,+,?) (int,int,graph(nodes,edges))
%
% 注意：该谓词生成“节点”列表和项u(V,F)的列表，这些项指示每个节点V未使用（或空闲）边的数量F
% 例如: with N=5, K=3 该算法开始于 Nodes=[1,2,3,4,5] 和 UList=[u(1,3),u(2,3),u(3,3),u(4,3),u(5,3)].
1 k_regular(K,N,graph(Nodes,Edges)) :-
2 range(1,N,Nodes), % generate Nodes list
3 maplist(mku(K),Nodes,UList), % generate initial UList
4 k_reg(UList,0,Edges).
5
6 mku(K,V,u(V,K)).
7
行注释:
1.
2.
3.
4.
5.
6.
7.
% k_reg(UList,MinY,Edges) :- Edges是e(X,Y)项的列表其中u(X,UX)是UList中的第一个元素，u(Y,UY)是UList的另一个元素,且Y>MinY. 分别指示X和Y的自由边数的UX和UY必须都大于0. 如果选择了边e(X,Y)，则对于递归它们都将减少1。
% (+,+,-) (ulist,int,elist)
8 k_reg([],_,[]).
9 k_reg([u(_,0)|Us],_,Edges) :-
10 !,
11 k_reg(Us,0,Edges). % 不再有未使用的边
12 k_reg([u(1,UX)|Us],MinY,[e(1,Y)|Edges]) :-
13 UX > 0, % 特殊情况 UX = 1
14 pick(Us,Y,MinY,Us1), % 选择一个Y
15 !,
16 UX1 is UX - 1, % 减少未使用边的数量
17 k_reg([u(1,UX1)|Us1],Y,Edges).
18 k_reg([u(X,UX)|Us],MinY,[e(X,Y)|Edges]) :-
19 X > 1,
20 UX > 0,
21 pick(Us,Y,MinY,Us1), % 选择一个Y
22 UX1 is UX - 1, % 减少未使用边的数量
23 k_reg([u(X,UX1)|Us1],Y,Edges).
24
行注释:
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
% pick(UList_in,Y,MinY,UList_out) :- 在UList_in中有一个元素u(Y,UY)，Y大于MinY，并且UY>0。通过将Uu在项u(Y,_)中减1，可以从UList_in获得UList_out。该谓词通过回溯传递Y的所有可能值。
% (+,-,+,-) (ulist,int,int,ulist)
25 pick([u(Y,UY)|Us],Y,MinY,[u(Y,UY1)|Us]) :-
26 Y > MinY,
27 UY > 0,
28 UY1 is UY - 1.
29 pick([U|Us],Y,MinY,[U|Us1]) :-
30 pick(Us,Y,MinY,Us1).
31
% range(X,Y,Ls) :- Ls是从X到Y的整数列表.
% (+,+,?) (int,int,int_list)
行注释:
25.
26.
27.
28.
29.
30.
31.
32 range(B,B,[B]).
33 range(A,B,[A|L]) :-
34 A < B,
35 A1 is A + 1,
36 range(A1,B,L).
37
行注释:
32.
33.
34.
35.
36.
37.
38 :- dynamic solution/1.
% all_k_regular(K,N,Gs) :- Gs是具有N个节点的所有(非同构)K-regular图的列表。
% (+,+,-) (int,int,list_of_graphs)
% 注意：谓词prints将每个新的解作为进度报告。
% 如果您不喜欢，请使用内部谓词tell(‘/dev/null’)关闭打印。
39 all_k_regular(K,N,_) :-
40 retractall(solution(_)),
41 k_regular(K,N,Graph),
42 no_iso_solution(Graph),
43 write(Graph), nl,
44 assert(solution(Graph)),
45 fail.
46 all_k_regular(_,_,Graphs) :-
47 findall(G,solution(G),Graphs).
48
行注释:
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49 :- ensure_loaded(p6_06). % 加载 isomorphic/2
% no_iso_solution(Graph) :- solution/1 数据库谓词(事实)中没有与图同构的图G
50 no_iso_solution(Graph) :-
51 solution(G),
52 isomorphic(Graph,G),
53 !,
54 fail.
55 no_iso_solution(_).
56
行注释:
49.
50.
51.
52.
53.
54.
55.
56.
%该程序的其余部分构造了一个K-regular简单图的表，其中N个节点的N个节点最多为N个，且K的明智值为。
% Example: ?- table(6).
57 table(Max) :-
58 nl, write('K-regular simple graphs with N nodes'), nl,
59 table(3,Max).
60
61 table(N,Max) :-
62 N =< Max,
63 !,
63 table(2,N,Max),
64 N1 is N + 1,
65 table(N1,Max).
66 table(_,_) :-
67 nl.
68
行注释:
57.
58.
59.
60.
61.
62.
63.
64.
65.
65.
67.
68.
69 table(K,N,Max) :-
70 K < N,
71 !,
72 tell('/dev/null'),
73 statistics(inferences,I1),
74 all_k_regular(K,N,Gs),
75 length(Gs,NSol),
76 statistics(inferences,I2),
77 NInf is I2 - I1,
78 told,
79 plural(NSol,Pl),
80 writef('\nN = %w K = %w %w solution%w (%w inferences)\n',[N,K,NSol,Pl,NInf]),
81 checklist(print_graph,Gs),
82 K1 is K + 1,
83 table(K1,N,Max).
84 table(_,_,_) :-
85 nl.
86
行注释:
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87 plural(X,' ') :-
88 X < 2,
89 !.
90 plural(_,'s').
91
92 :- ensure_loaded(p6_01). % conversion human_gterm/2
93
94 print_graph(G) :-
95 human_gterm(HF,G),
96 write(HF), nl.
行注释:
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
9361
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
