1 % (c) 2019-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4 :- module(bliss_interface, [init_bliss_interface/0,
5 init_directed_graph/0,
6 init_undirected_graph/0,
7 add_node/2,
8 add_node/3,
9 add_edge/2,
10 find_automorphisms/1,
11 get_canonical_form/1,
12 graph_to_dot_file/1]).
13
14 %% find_automorphisms(-PermGroup).
15 % Find graph automorphisms yielding a permutation group,
16 % each permutation in the group is given by a generator which is represented in cycle notation.
17
18 %% get_canonical_form(-CanonicalLabeling).
19 % Fetch the canonical labeling of the graph: a list whose i-th element (starting at 0) is the new id of node i.
20
21 foreign_resource('bliss_interface', [init_directed_graph_wrapper,
22 init_undirected_graph_wrapper,
23 add_node_wrapper,
24 add_edge_wrapper,
25 find_automorphisms,
26 get_canonical_form]).
27
28 foreign(init_directed_graph_wrapper, c, init_directed_graph_wrapper).
29 foreign(init_undirected_graph_wrapper, c, init_undirected_graph_wrapper).
30 foreign(add_node_wrapper, c, add_node_wrapper(+integer, [-integer])).
31 foreign(add_edge_wrapper, c, add_edge_wrapper(+integer, +integer)).
32 foreign(find_automorphisms, c, find_automorphisms([-term])).
33 foreign(get_canonical_form, c, get_canonical_form([-term])).
34
35 :- dynamic is_initialised/0, amount_of_nodes/1, dot_edge/2, is_directed_graph/0, node_color/2, node_label/2, color_code/2.
36 :- volatile is_initialised/0, amount_of_nodes/1, dot_edge/2, is_directed_graph/0, node_color/2, node_label/2, color_code/2.
37
38 :- use_module(probsrc(pathes_lib),[safe_load_foreign_resource/2]).
39 :- use_module(library(aggregate),[aggregate_all/3]).
40 :- use_module(library(codesio),[format_to_codes/3, write_to_codes/2]).
41
42 %% init_bliss_interface.
43 init_bliss_interface :-
44 \+ is_initialised,
45 reset_state,
46 !,
47 safe_load_foreign_resource(bliss_interface,bliss_interface),
48 asserta(is_initialised).
49 init_bliss_interface.
50
51 %% init_directed_graph.
52 % Clear graph and start creating a directed graph.
53 init_directed_graph :-
54 reset_state,
55 asserta(is_directed_graph),
56 init_directed_graph_wrapper.
57
58 %% init_undirected_graph.
59 % Clear graph and start creating an undirected graph.
60 init_undirected_graph :-
61 reset_state,
62 init_undirected_graph_wrapper.
63
64 %% add_node(+Color, -Id).
65 % Create a new node with the given colour and return the id.
66 add_node(Color, Id) :-
67 inc_nodes,
68 add_node_wrapper(Color, Id),
69 asserta(node_color(Id,Color)).
70
71 %% add_node(+Label, +Color, -Id).
72 % Label is used for dot graph visualization.
73 add_node(Label, Color, Id) :-
74 add_node(Color, Id),
75 asserta(node_label(Id,Label)).
76
77 %% add_edge(+Id1, +Id2).
78 % Create an edge between two ids.
79 add_edge(Id1, Id2) :-
80 amount_of_nodes(Nodes),
81 Id1 >= 0,
82 Id2 >= 0,
83 Id1 < Nodes,
84 Id2 < Nodes,
85 add_dot_edge(Id1, Id2),
86 add_edge_wrapper(Id1, Id2).
87
88 %% graph_to_dot_file(+FilePath).
89 graph_to_dot_file(FilePath) :-
90 open(FilePath, write, S, [encoding(utf8)]),
91 dot_file_header(S),
92 dot_node_attributes(S),
93 dot_file_edges(S),
94 write(S, '}'),
95 close(S).
96
97 inc_nodes :-
98 retract(amount_of_nodes(Old)),
99 New is Old + 1,
100 asserta(amount_of_nodes(New)).
101
102 add_dot_edge(Id1, Id2) :-
103 ( dot_edge(Id1, Id2)
104 -> true
105 ; asserta(dot_edge(Id1, Id2))
106 ).
107
108 reset_state :-
109 retractall(is_directed_graph),
110 retractall(amount_of_nodes(_)),
111 retractall(node_color(_,_)),
112 retractall(node_label(_,_)),
113 retractall(dot_edge(_,_)),
114 asserta(amount_of_nodes(0)).
115
116 dot_node_attributes(S) :-
117 findall((Id,Color), node_color(Id, Color), NodeColors),
118 retractall(color_code(_,_)),
119 dot_node_attributes(NodeColors, S).
120
121 dot_node_attributes([], _).
122 dot_node_attributes([(Id,Color)|T], S) :-
123 get_color_code(Color, ColorCode),
124 format(S, '~w [style="filled" color="~w"', [Id,ColorCode]),
125 ( node_label(Id, Label)
126 -> write(S, ' label="'),
127 write_dot_escaped(S, Label),
128 write(S, '"')
129 ; true
130 ),
131 write(S, ']'),
132 nl(S),
133 dot_node_attributes(T, S).
134
135 % Each node colour gets a distinct light colour, given as "hue saturation value" (as accepted by Graphviz).
136 % The hues are spread using the golden ratio; unlike random colours, this does not change the state of library(random).
137 get_color_code(Color, ColorCode) :-
138 ( color_code(Color, TColorCode)
139 -> ColorCode = TColorCode
140 ; aggregate_all(count, color_code(_,_), Nr),
141 Hue is (Nr * 0.618033988749895) - floor(Nr * 0.618033988749895),
142 format_to_codes('~4f 0.400 1.000', [Hue], Codes),
143 atom_codes(ColorCode, Codes),
144 assertz(color_code(Color, ColorCode))
145 ).
146
147 % Labels can be arbitrary terms; " and \ must be escaped in DOT strings.
148 write_dot_escaped(S, Label) :-
149 write_to_codes(Label, Codes),
150 escape_dot_codes(Codes, Escaped),
151 atom_codes(Atom, Escaped),
152 write(S, Atom).
153
154 escape_dot_codes([], []).
155 escape_dot_codes([C|T], Res) :-
156 ( (C =:= 0'" ; C =:= 0'\\)
157 -> Res = [0'\\,C|RT]
158 ; Res = [C|RT]
159 ),
160 escape_dot_codes(T, RT).
161
162 dot_file_edges(S) :-
163 ( is_directed_graph
164 -> EdgeOp = '->'
165 ; EdgeOp = '--' % DOT does not allow -> in undirected graphs
166 ),
167 findall(Id1-Id2, dot_edge(Id1, Id2), DotEdges),
168 dot_file_edges(DotEdges, EdgeOp, S).
169
170 dot_file_edges([], _, _).
171 dot_file_edges([Id1-Id2|T], EdgeOp, S) :-
172 format(S, '~w ~w ~w;~n', [Id1,EdgeOp,Id2]),
173 dot_file_edges(T, EdgeOp, S).
174
175 dot_file_header(S) :-
176 is_directed_graph,
177 !,
178 write(S, 'digraph bliss_graph {'),
179 nl(S).
180 dot_file_header(S) :-
181 write(S, 'graph bliss_graph {'),
182 nl(S).