1 % (c) 2009-2025 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
5
6 /* visualize_graph.pl */
7 :- module(visualize_graph,[tcltk_print_states_for_dot/1, tcltk_print_states_for_dot/2,
8 tcltk_print_states_for_dot_sfdp/1, tcltk_print_states_for_dot_sfdp/2,
9 tcltk_print_neighbourhood_states_for_dot/2,
10 tcltk_print_current_state_for_dot/1,
11 tcltk_print_shortest_trace_to_current_state_for_dot/1,
12 %tcltk_print_trace_to_current_state_for_dot/1, % removed
13 tcltk_print_current_state_as_graph_for_dot/1, tcltk_print_state_as_graph_for_dot/2,
14 tcltk_print_history_to_current_state_for_dot/1,
15 tcltk_print_history_to_current_state_with_neighbors_for_dot/1,
16 % tcltk_print_transition_diagram_for_variable_or_expr/2, % moved to state_space_reduction
17 tcltk_print_definitions_as_graph_for_dot/1,
18 tcltk_print_predicate_dependency_as_graph_for_dot/2,
19 tcltk_print_csp_process_states_for_dot/2,
20 print_graph_header/1,
21 print_graph_footer/0,
22
23 convert_state_to_string/2]).
24
25
26 :- use_module(probsrc(module_information)).
27 :- module_info(group,dot).
28 :- module_info(description,'This module generates various dot graphs (state space, single state, transition diagram,...).').
29
30 :- use_module(library(lists)).
31 :- use_module(probsrc(preferences)).
32
33 :- use_module(probsrc(debug)).
34 :- use_module(probsrc(translate)).
35 :- use_module(probsrc(bmachine),[b_is_constant/1]).
36
37 :- use_module(probsrc(state_space)).
38 :- use_module(dotsrc(dot_graph_generator),[translate_bvalue_to_colour/2, translate_int_col/2]).
39 :- use_module(probsrc(state_space_exploration_modes),[compute_heuristic_function_for_state_id/2]).
40
41 /* --------------------------------------------------- */
42 /* MAIN ENTRY POINTS FOR TCL */
43 /* --------------------------------------------------- */
44
45
46 % print full state space for dot:
47
48 % a version for large graphs; where we automatically turn off some details
49 tcltk_print_states_for_dot_sfdp(F) :-
50 tcltk_print_states_for_dot_sfdp(F,colour_transitions).
51 tcltk_print_states_for_dot_sfdp(F,ColourTransitions) :-
52 temporary_set_preference(dot_print_node_info,false,CHNG1),
53 temporary_set_preference(dot_print_node_properties,false,CHNG2),
54 temporary_set_preference(dot_print_self_loops,false,CHNG3),
55 temporary_set_preference(dot_fill_normal_nodes,true,CHNG4),
56 call_cleanup(tcltk_print_states_for_dot(F,ColourTransitions),
57 (preferences:reset_temporary_preference(dot_print_node_info,CHNG1),
58 preferences:reset_temporary_preference(dot_print_node_properties,CHNG2),
59 preferences:reset_temporary_preference(dot_print_self_loops,CHNG3),
60 preferences:reset_temporary_preference(dot_fill_normal_nodes,CHNG4))).
61
62 tcltk_print_states_for_dot(F) :- tcltk_print_states_for_dot(F,no_colour_for_transitions).
63 tcltk_print_states_for_dot(F,ColourTransitions) :-
64 format('Writing states to dot file ~w~n',[F]),
65 tell(F),(tcltk_print_states_for_dot_aux(ColourTransitions) -> true ; true),told.
66
67 tcltk_print_states_for_dot_aux(ColourTransitions) :-
68 reset_label_nr(ColourTransitions),
69 print_graph_header(visited_states),
70 visited_expression_id(NodeID),
71 tcltk_print_node_for_dot(NodeID),
72 tcltk_print_transitions_for_dot(NodeID,_),
73 fail.
74 tcltk_print_states_for_dot_aux(_ColourTransitions) :-
75 print_graph_footer.
76
77
78 tcltk_print_neighbourhood_states_for_dot(Dist,F) :-
79 retractall(unfiltered_state(_,_)),
80 current_state_id(CurID),
81 (dfs(CurID,Dist) -> true ; true), % mark neighbours until distance Dist
82 tell(F),(tcltk_print_unfiltered_states_for_dot -> true ; true),told.
83
84 :- dynamic unfiltered_state/2.
85 dfs(ID,Dist) :- unfiltered_state(ID,D1), (D1>=Dist -> ! ; retract(unfiltered_state(ID,D1))),fail.
86 dfs(ID,Dist) :- assertz(unfiltered_state(ID,Dist)), D1 is Dist-1,
87 D1>0,
88 any_transition(ID,_,NodeID),
89 dfs(NodeID,D1).
90
91 tcltk_print_unfiltered_states_for_dot :- reset_label_nr,
92 print_graph_header_with_layout(neighbourhood,sfdp),
93 unfiltered_state(NodeID,Dist),
94 tcltk_print_node_for_dot(NodeID,[pendwidth/Dist]),
95 tcltk_print_transitions_for_dot(NodeID,_),
96 fail.
97 tcltk_print_unfiltered_states_for_dot :-
98 print_graph_footer.
99
100 % --------------------------
101 tcltk_print_csp_process_states_for_dot(F,ProcID) :-
102 tell(F),(tcltk_print_csp_process_states_for_dot_root(ProcID) -> true ; true),told.
103
104 tcltk_print_csp_process_states_for_dot_root(ProcID) :-
105 reset_label_nr,
106 print_graph_header(csp_process),
107 tcltk_print_node_for_dot(root),
108 tcltk_print_transitions_for_dot(root,ProcID),
109 tcltk_print_csp_process_states_for_dot.
110
111 :- use_module(extrasrc(refinement_checker),[dvisited/1]).
112 tcltk_print_csp_process_states_for_dot :-
113 dvisited(NodeID),
114 tcltk_print_node_for_dot(NodeID),
115 tcltk_print_transitions_for_dot(NodeID,_),
116 fail.
117 tcltk_print_csp_process_states_for_dot :-
118 print_graph_footer.
119
120 % --------------------------
121
122 % just print the current state in the state space, not showing internal structure as graph!
123 tcltk_print_current_state_for_dot(F) :-
124 tell(F), (tcltk_print_current_state_for_dot -> true ; true),told.
125 tcltk_print_current_state_for_dot :-
126 reset_label_nr,
127 print_graph_header(current_state),
128 current_state_id(CurID),
129 ( NodeID=CurID ;
130 any_transition(CurID,_,NodeID)),
131 tcltk_print_node_for_dot(NodeID),
132 fail.
133 tcltk_print_current_state_for_dot :-
134 current_state_id(CurID),
135 tcltk_print_transitions_for_dot(CurID,_),
136 fail.
137 tcltk_print_current_state_for_dot :-
138 print_graph_footer.
139
140 :- use_module(probsrc(tcltk_interface),[find_shortest_trace_to_node/4]).
141 tcltk_print_shortest_trace_to_current_state_for_dot(F) :-
142 tell(F), (tcltk_print_shortest_trace_to_current_state_for_dot -> true ; true),told.
143 tcltk_print_shortest_trace_to_current_state_for_dot :-
144 reset_label_nr,
145 print_graph_header(shortest_trace_to_current_state),
146 current_state_id(CurID),
147 find_shortest_trace_to_node(root,CurID,_,StateIDList),
148 print_trace_to_current_state(StateIDList),
149 print_graph_footer.
150
151
152 tcltk_print_history_to_current_state_for_dot(F) :-
153 tell(F), (tcltk_print_history_to_current_state_for_dot -> true ; true),told.
154 tcltk_print_history_to_current_state_for_dot :-
155 reset_label_nr,
156 print_graph_header(history),
157 current_state_id(CurID),
158 history(H),
159 reverse([CurID|H],IDList),
160 print_trace_to_current_state(IDList),
161 print_graph_footer.
162
163 % called for fairness formulas (currently only in CSP refinement checking mode)
164 tcltk_print_history_to_current_state_with_neighbors_for_dot(F) :-
165 tell(F), (tcltk_print_history_to_current_state_with_neighbors_for_dot -> true ; true),told.
166 tcltk_print_history_to_current_state_with_neighbors_for_dot :-
167 reset_label_nr,
168 print_graph_header(history),
169 current_state_id(CurID),
170 history(H),
171 reverse([CurID|H],IDList),
172 print_trace_with_neighbors_to_current_state(IDList),
173 print_graph_footer.
174
175 /* ---------------------------------------------------------------------- */
176
177
178 :- use_module(dotsrc(dot_graph_generator), [gen_dot_graph/5, dot_no_same_rank/1]).
179
180 % this predicate is currently not used anywhere, print_cstate_graph is used instead
181 tcltk_print_current_state_as_graph_for_dot(File) :-
182 current_expression(_CurID,State),
183 tcltk_print_state_as_graph_for_dot(State,File).
184 tcltk_print_state_as_graph_for_dot(State,File) :-
185 %print(gen_graph(State)),nl,
186 gen_dot_graph(File,dot_state_node,dot_state_trans(State),dot_no_same_rank,dot_subgraph).
187
188 :- use_module(probsrc(b_global_sets),[b_global_set/1,is_b_global_constant/3,all_elements_of_type/2]).
189 dot_state_node(ID,SET,Desc,box,none,Color) :-
190 b_global_set(SET), Desc = ID,
191 if(is_b_global_constant(SET,_Nr,Cst),
192 (Color=red,ID = Cst),
193 (Color=blue,
194 all_elements_of_type(SET,AllVals),
195 member(X,AllVals),
196 translate_bvalue(X,ID)
197 )
198 ).
199 dot_state_node(root,none,'','Mdiamond',none,green).
200
201 dot_subgraph(SubGraph,filled,lightgray) :-
202 b_global_set(SubGraph).
203
204 % old version:
205 %dot_same_rank(TVals) :-
206 % b_global_set(SET),all_elements_of_type(SET,AllVals),translate_values(AllVals,TVals).
207
208 :- use_module(probsrc(store),[get_id_value/3]).
209 dot_state_trans(State,NodeID,Label,SuccNodeID,Color,Style) :- Style=solid,
210 get_id_value(VarOrConstant,State,VarValue),
211 dot_state_trans_var(VarValue,NodeID,SuccNodeID,VarOrConstant,Label),
212 (b_is_constant(VarOrConstant) -> Color=blue ; Color=black).
213
214 :- use_module(probsrc(gensym)).
215
216 dot_state_trans_var(VarValue,NodeID,SuccNodeID,Var,Var) :-
217 dot_state_basic_pair(VarValue,X1,X2), /* we have a relation or a pair */
218 dot_state_basic_type(X1), El1=X1,
219 dot_state_basic_type(X2), El2=X2, /* in case it is a function: we can also accept El2 to be dot_state_basic_type_or_element */
220 translate_bvalue(El1,NodeID),
221 translate_bvalue(El2,SuccNodeID).
222 dot_state_trans_var(VarValue,NodeID,SuccNodeID,Var,Var) :-
223 dot_state_basic_type_or_element(VarValue,V),
224 NodeID = root,
225 translate_bvalue(V,SuccNodeID).
226 dot_state_trans_var(VarValue,NodeID,SuccNodeID,Var,Label) :-
227 ( (member(X,VarValue),Kind=el)
228 ; (VarValue=(X,_),Kind=prj1)
229 ; (VarValue=(_,X),Kind=prj2)
230 ),
231 \+ directly_representable_element(X),
232 gensym(Var,IntNode),
233 ((NodeID = root, SuccNodeID = IntNode, Label=Var)
234 ;
235 dot_state_trans_internal(IntNode,Kind,X,NodeID,SuccNodeID,Label)
236 ).
237
238
239 directly_representable_element(X) :- dot_state_basic_type(X).
240 directly_representable_element((X1,X2)) :-
241 dot_state_basic_type(X1),
242 dot_state_basic_type(X2).
243
244 dot_state_basic_type(fd(_,_)).
245 dot_state_basic_type(int(_)).
246 dot_state_basic_type(pred_false /* bool_false */).
247 dot_state_basic_type(pred_true /* bool_true */).
248 dot_state_basic_type(string(_)).
249
250 dot_state_basic_type_or_element(X,X) :- dot_state_basic_type(X).
251 dot_state_basic_type_or_element(S,X) :- member(X,S), dot_state_basic_type(X).
252 dot_state_basic_type_or_element([],empty_set).
253
254 :- use_module(library(avl),[avl_member/2]).
255 dot_state_basic_pair((X1,X2),X1,X2).
256 dot_state_basic_pair([H|T],X1,X2) :- member((X1,X2),[H|T]).
257 dot_state_basic_pair(avl_set(A),X1,X2) :- avl_member((X1,X2),A).
258
259 dot_state_trans_internal(IntNode,Kind,VarValue,NodeID,SuccNodeID,Label) :-
260 dot_state_basic_type_or_element(VarValue,V),
261 translate_bvalue(V,SuccNodeID),
262 NodeID = IntNode, Label=Kind.
263 dot_state_trans_internal(IntNode,Kind,VarValue,NodeID,SuccNodeID,Label) :-
264 dot_state_basic_pair(VarValue,X1,X2), /* we have a relation or a pair */
265 dot_state_basic_type_or_element(X1,El1),
266 dot_state_basic_type_or_element(X2,El2),
267 NodeID = IntNode,
268 ( (translate_bvalue(El1,SuccNodeID), Label = prj1(Kind))
269 ;(translate_bvalue(El2,SuccNodeID), Label = prj2(Kind))
270 ).
271 /* MISSING: recursion */
272
273 /* ---------------------------------------------------------------------- */
274
275
276 print_graph_header(Type) :-
277 format('digraph ~w {~n',[Type]),
278 % print('graph [orientation=landscape, page="8.5, 11",ratio=fill,size="7.5,10"];'),nl. % old default layout
279 % print('graph [page="8.5, 11",ratio=fill,size="7.5,10"];'),nl.
280 (get_preference(dot_horizontal_layout,true) -> RDir=', rankdir=LR'; RDir=''), % default is TB
281 format('graph [nodesep=1.5, ranksep=1.5~w];~n',[RDir]).
282
283 % Layout = sdfp, fdp, twopi, dot, ...
284 print_graph_header_with_layout(Type,Layout) :-
285 format('digraph ~w {~n',[Type]),
286 (get_preference(dot_horizontal_layout,true) -> RDir=', rankdir=LR'; RDir=''), % default is TB
287 format('graph [nodesep=1.5, ranksep=1.5, layout=~w~w];~n',[Layout,RDir]).
288 % other possible options for graph: splines=true overlap=false ?
289
290 print_graph_footer :- print('}'),nl.
291
292
293 /* ---------------------------------------------------------------------- */
294
295 :- use_module(library(lists),[clumps/2]).
296 :- use_module(library(samsort)).
297 :- use_module(probsrc(tools),[ajoin/2]).
298 print_trace_to_current_state(IDList) :-
299 samsort(IDList,SIDList), % keeps duplicates
300 clumps(SIDList,Clumps),
301 member([NodeID|T],Clumps),
302 (length([NodeID|T],Len),Len>1
303 -> ajoin(['repeated (',Len,')'],Lbl),
304 tcltk_print_node_for_dot(NodeID,[extralabel/Lbl])
305 ; tcltk_print_node_for_dot(NodeID)),
306 fail.
307 print_trace_to_current_state(IDList) :-
308 temporary_set_preference(dot_print_self_loops,true,CHNG3),
309 print_trace_to_current_state2(IDList),
310 preferences:reset_temporary_preference(dot_print_self_loops,CHNG3).
311
312 print_trace_to_current_state2([]).
313 print_trace_to_current_state2([_]).
314 print_trace_to_current_state2([ID1,ID2|Tail]) :-
315 tcltk_print_transitions_for_dot(ID1,ID2),
316 print_trace_to_current_state2([ID2|Tail]).
317
318 print_trace_with_neighbors_to_current_state(IDList) :- sort(IDList,SIDList),
319 member(NodeID,SIDList),
320 tcltk_print_node_for_dot(NodeID),
321 fail.
322 print_trace_with_neighbors_to_current_state(IDList) :-
323 current_state_id(CurID),
324 nth1(N,IDList,CurID,_Rest),!,
325 append_length(PathToLoop,LoopIDs,IDList,N),
326 %format(user_output,'~w pos=~w : ~w , path to loop=~w, loop=~w~n',[CurID,N,IDList,PathToLoop,LoopIDs]),
327 temporary_set_preference(dot_print_self_loops,true,CHNG3),
328 print_trace_to_current_state2(PathToLoop), % print path to loop
329 print_trace_with_neighbors_to_current_state2([CurID|LoopIDs],IDList), % print loop (with neighbors, because of the fairness check),
330 preferences:reset_temporary_preference(dot_print_self_loops,CHNG3).
331
332 print_trace_with_neighbors_to_current_state2([],_).
333 print_trace_with_neighbors_to_current_state2([ID|Tail],IDList) :-
334 findall(ID,(transition(ID,_,_,SuccID),
335 \+ append(_,[ID,SuccID|_],IDList), % check if the edge is not already shown
336 % format(user_output,'Neighb: ~w -> ~w : idlist=~w, tail=~w~n',[ID,SuccID,IDList,Tail]),
337 tcltk_print_transitions_for_dot(ID,SuccID)),_IDList),
338 print_trace_with_neighbors_to_current_state2(Tail,IDList).
339
340 extract_b_store(csp_and_b(_,T),R) :- !, R=T.
341 extract_b_store(R,R).
342
343 extract_full_store(concrete_constants(C),R) :- !,R=C.
344 extract_full_store(const_and_vars(ConstID,Vars),R) :- !,
345 specfile:expand_const_and_vars(ConstID,Vars,R).
346 extract_full_store(R,R).
347
348 :- use_module(probsrc(tools),[print_escaped/1]).
349 :- use_module(probsrc(state_space),[counterexample_node/1, counterexample_op/1]).
350 :- use_module(probsrc(model_checker),[find_invariant_error/4]).
351 :- use_module(probsrc(specfile),[animation_mode/1]).
352
353 tcltk_print_node_for_dot(ID) :- tcltk_print_node_for_dot(ID,[]).
354
355 tcltk_print_node_for_dot(NodeID,Options) :-
356 animation_mode(AM),
357 visited_expression(NodeID,CurT),
358 extract_b_store(CurT,CurBT),
359 extract_full_store(CurBT,CurTemp),
360 (NodeID=root -> preference(dot_print_root,true) ; true),
361 (member(shape/Shape,Options) -> true ; dot_node_shape(NodeID,CurTemp,Shape)),
362 % TO DO: penwidth=2.0, fillcolor="#F1F2D8"
363 (find_invariant_error(AM,NodeID,CurTemp,_)
364 -> get_preference(dot_invariant_violated_node_colour,NodeColor),
365 Style=filled
366 ; counterexample_node(NodeID)
367 -> get_preference(dot_counterexample_node_colour,NodeColor),
368 (is_goal_node(NodeID) -> Style = 'rounded,filled', get_preference(dot_goal_node_colour,FillColor)
369 ; Style=none, FillColor=none)
370 ; is_goal_node(NodeID)
371 -> get_preference(dot_goal_node_colour,NodeColor),
372 Style='rounded,filled'
373 ; (preference(dot_fill_normal_nodes,true) -> Style='rounded,filled' ; Style=none),
374 (member(color/NodeColor,Options) -> true ; dot_node_color(NodeID,NodeColor))
375 ),
376 (member(fontsize/FSize,Options) -> true ; get_preference(dot_node_font_size,FSize)),
377 (Style=none
378 -> format('~w [shape=~w, color=\"~w\", fontsize=~w',[NodeID,Shape,NodeColor,FSize])
379 ; FillColor=none
380 -> format('~w [shape=~w, style=\"~w\", color=\"~w\", fontsize=~w',[NodeID,Shape,Style, NodeColor,FSize])
381 ; format('~w [shape=~w, style=\"~w\", color=\"~w\", fillcolor=\"~w\", fontsize=~w',
382 [NodeID,Shape,Style, NodeColor,FillColor,FSize])
383 ),
384
385 (member(pendwidth/PenWidth,Options) -> true ; get_preference(dot_node_penwidth,PenWidth)),
386 (PenWidth = 1 -> true ; print(', penwidth='), print(PenWidth)),
387 write(', label=\"'),
388 (member(extralabel/ExtraLbl,Options) -> print_escaped(ExtraLbl), print('\\n') ; true),
389 (preference(dot_print_node_ids,true) -> print(NodeID), print(':\\n') ; true),
390 (preference(dot_print_node_info,true)
391 -> convert_state_to_string(CurT,StateAsString),
392 print_escaped(StateAsString) % quoted encode; except for
393 ; true
394 ),
395 (preference(dot_print_node_properties,true)
396 -> print_node_properties(NodeID)
397 ; true
398 ),
399 print('\"];'),nl,
400 fail.
401 tcltk_print_node_for_dot(_NodeID,_) :- nl.
402
403
404 :- use_module(probsrc(model_checker),[node_satisfies_goal/1]).
405 is_goal_node(NodeID) :- preference(dot_colour_goal_nodes,true),
406 node_satisfies_goal(NodeID). % TO DO csp goal
407
408 dot_node_shape(_StateId,State,triangle) :-
409 % state with abort values
410 memberchk(bind(_,term(no_value_for(_))),State),!.
411 dot_node_shape(root,_State,Shape) :-
412 % the root state
413 !,get_preference(dot_root_shape,Shape).
414 dot_node_shape(StateId,_State,Shape) :-
415 % the currently displayed state in the animation
416 current_state_id(StateId),!,
417 get_preference(dot_current_node_shape,Shape).
418 dot_node_shape(StateId,_State,diamond) :-
419 % a state which was subject to permutation flooding
420 transition(StateId,'*permute*',_),!.
421 dot_node_shape(_StateId,_State,Shape) :-
422 % a normal state
423 get_preference(dot_normal_node_shape,Shape).
424
425
426 dot_node_color(StateId,Color) :-
427 % an open state where not all transitions are yet calculated
428 not_all_transitions_added(StateId),!,
429 get_preference(dot_open_node_colour,Color).
430 dot_node_color(StateId,Color) :-
431 % a state which is outside the user-defined state space that should be model-checked
432 not_interesting(StateId),!,
433 get_preference(dot_scope_limit_node_colour,Color).
434 dot_node_color(StateId,Color) :-
435 transition(StateId,'*permute*',_),!, Color = lightgray.
436 dot_node_color(StateId,Color) :-
437 %get_preference(dot_normal_node_colour,Color),
438 compute_heuristic_function_for_state_id(StateId,HRes),
439 !,
440 translate_bvalue_to_colour(HRes,Color). %tools:print_message(heur(HRes,Color)).
441 dot_node_color(_StateId,Color) :-
442 get_preference(dot_normal_node_colour,Color).
443
444
445 :- use_module(probsrc(specfile),[property/2,elementary_prop/2,b_or_z_mode/0]).
446
447 print_node_properties(ID) :-
448 print(' Prop={'),
449 visited_expression(ID,State),
450 get_state_property(State,PropAsString),
451 print_string_for_dot(PropAsString), print('\\'),print('n'),
452 fail.
453 print_node_properties(_) :- print('}').
454
455 get_state_property(State,PropAsString) :-
456 specfile:property(State,Prop),
457 translate:translate_property_with_limit(Prop,320,PropAsString).
458
459 :- use_module(probsrc(bmachine),[b_get_machine_animation_expression/2]).
460 :- use_module(probsrc(specfile),[state_corresponds_to_fully_setup_b_machine/2]).
461 get_animation_expression_value(State,PropAsString) :-
462 b_or_z_mode,
463 b_get_machine_animation_expression('ANIMATION_EXPRESSION',AExpr),
464 state_corresponds_to_fully_setup_b_machine(State,BState),
465 b_interpreter:b_compute_expression_nowf(AExpr,[],BState,AValue,'ANIMATION_EXPRESSION',0),
466 translate:translate_bvalue(AValue,PropAsString).
467
468
469 tcltk_print_transitions_for_dot(NodeID,SuccID) :-
470 transition(NodeID,Action,TransID,SuccID),
471 visited_expression(NodeID,State), set_translation_context(State),
472 (NodeID=root -> preference(dot_print_root,true) ; true),
473 (Action = '-->'(_Func,_)
474 -> (NodeID \= SuccID ; preference(dot_print_functions,true))
475 ; true),
476 (NodeID \= SuccID -> true ; preference(dot_print_self_loops,true)),
477 format('~w -> ~w',[NodeID,SuccID]),
478 (preference(dot_print_arc_colors,true) ->
479 (NodeID==root
480 -> print(' [style = dotted, color = black, label=\"')
481 ; (Action = '*permute*'
482 -> ArcCol=gray
483 ; counterexample_op(TransID)
484 -> get_preference(dot_counterexample_op_colour,ArcCol)
485 ; dot_arc_color(TransID, Action, ArcCol)
486 ),
487 format(' [color = \"~w\", label=\"',[ArcCol])
488 )
489 ; print(' [label=\"')
490 ),
491 dot_print_action(Action),
492 (get_preference(dot_print_transition_ids,true) -> format('\n~w',[TransID]) ; true),
493 get_preference(dot_edge_font_size,FSize),
494 get_preference(dot_edge_penwidth,PenWidth),
495 (PenWidth = 1
496 -> format('\", fontsize=~w];~n',[FSize])
497 ; format('\", fontsize=~w, penwidth=~w];~n',[FSize,PenWidth])
498 ),
499 fail.
500 tcltk_print_transitions_for_dot(_NodeID,_SuccID) :- clear_translation_constants,nl.
501
502
503 %dot_arc_color(TransID, blue) :-
504 % b_abstract_mappings:widened_trans(TransID),!.
505 dot_arc_color(_,Action,ArcCol) :-
506 get_label_nr(Action,Nr), Nr>0,
507 translate_int_col(Nr,ArcCol),
508 !.
509 dot_arc_color(_TransId,_Action, ArcCol) :-
510 (preference(dot_normal_arc_colour,ArcCol) -> true ; ArcCol=blue).
511 % TO DO: enable colouring; particularly in sfdp mode
512
513 :- dynamic label_nr/2, next_label_nr/1.
514 next_label_nr(0).
515 reset_label_nr :- retractall(label_nr(_,_)), retractall(next_label_nr(_)).
516 reset_label_nr(Colour) :- reset_label_nr,
517 (Colour=colour_transitions
518 -> assertz(next_label_nr(0)) % asserts next label nr: we will colour transitions
519 ; true).
520
521 get_label_nr(Action,Nr) :- functor(Action,F,_),
522 (label_nr(F,FNr) -> Nr=FNr
523 ; retract(next_label_nr(N)), N1 is N+1, assertz(next_label_nr(N1)), assertz(label_nr(F,N)), Nr=N).
524
525
526 dot_print_action(_) :- preference(dot_print_edge_labels,false),!.
527 dot_print_action(Action) :- preference(dot_print_action_arguments,true),
528 translate:translate_event(Action,ActionAsString),
529 print_string_for_dot(ActionAsString),!.
530 dot_print_action('-->'(FAction,_R)) :- nonvar(FAction),
531 functor(FAction,OperationName,_),!,
532 print_string_for_dot(OperationName).
533 dot_print_action(Action) :- nonvar(Action), functor(Action,OperationName,_),!,
534 print_string_for_dot(OperationName).
535 dot_print_action(Action) :- print('err:'),print_string_for_dot(Action).
536
537 :- use_module(probsrc(tools),[wrap_and_truncate_atom/4,string_escape/2]).
538 print_string_for_dot(String) :- string_escape(String,EString),
539 wrap_and_truncate_atom(EString,50,350,NS), print(NS).
540
541 /* ------------------------------------------------------------ */
542 /* converting a state into a string for the graph visualization */
543 /* ------------------------------------------------------------ */
544
545
546 :- use_module(probsrc(tools),[string_concatenate/3]).
547 convert_state_to_string(root,'root') :- !.
548 convert_state_to_string(State,String) :-
549 get_animation_expression_value(State,V),!,
550 String=V.
551 convert_state_to_string(StateTempl,StateAsString) :- animation_mode(xtl),!,
552 convert_state_to_string_default(StateTempl,StateAsString).
553 convert_state_to_string(concrete_constants(CurTemp),StateAsString) :- !,
554 findall(FProp,elementary_prop(CurTemp,FProp),State), /* was fd_findall */
555 translate_params_for_dot(State,StateAsString).
556 convert_state_to_string(const_and_vars(ConstID,StateTempl),StateAsString) :- !,
557 set_translation_constants(ConstID),
558 convert_state_to_string(StateTempl,StateAsString),
559 clear_translation_constants.
560 convert_state_to_string(csp_and_b(CSPState,BState),StateAsString) :- !,
561 translate_cspm_state(CSPState,CSPText),
562 convert_state_to_string(BState,BString),
563 string_concatenate(CSPText,'\n',C2),
564 string_concatenate(C2,BString,StateAsString).
565 convert_state_to_string([H|T],StateAsString) :- !,
566 CurTemp=[H|T],
567 findall(FProp,elementary_prop(CurTemp,FProp),State), /* was fd_findall */
568 translate_params_for_dot(State,StateAsString).
569 convert_state_to_string(StateTempl,StateAsString) :-
570 convert_state_to_string_default(StateTempl,StateAsString).
571
572 convert_state_to_string_default(StateTempl,StateAsString) :-
573 findall(FProp,
574 (property(StateTempl,Prop),filter_elementary_prop(Prop,FProp)),
575 State), /* was fd_findall */
576 translate_params_for_dot_nl(State,StateAsString).
577
578 filter_elementary_prop(X,R) :- \+ b_or_z_mode,!,R=X.
579 filter_elementary_prop('='(Cst,_V),_) :- nonvar(Cst),
580 b_is_constant(Cst),!,fail.
581 filter_elementary_prop(Relation,_) :-
582 functor(Relation,Func,_),
583 b_is_constant(Func),!,fail.
584 filter_elementary_prop('='(_X,pred_false /* bool_false */),_) :- !,fail. /* do not show boolean variables that are false */
585 filter_elementary_prop('='( X,pred_true /* bool_true */), X) :- !. /* just show the boolean variable, not that it is = true */
586 filter_elementary_prop(X,X).
587
588
589 /* ---------------------- */
590 /* DEFINITION dependency */
591 /* ---------------------- */
592
593 % show definition call graph
594
595 :- use_module(dotsrc(dot_graph_generator), [dot_no_same_rank/1]).
596 tcltk_print_definitions_as_graph_for_dot(File) :-
597 gen_dot_graph(File,dot_def_node,dot_def_trans,dot_no_same_rank,dot_def_subgraph).
598
599
600 :- use_module(probsrc(bmachine),[b_get_definition/5]).
601 :- use_module(library(ordsets),[ord_member/2]).
602
603 dot_def_node(0,none,'No DEFINITIONS visible',box,none,red) :-
604 \+ b_get_definition(_,_,_,_,_),!.
605 dot_def_node(DEFID,SubGraph,Desc,box,none,Color) :-
606 findall(Called, (b_get_definition(_,_,_,_,Deps), member(Called,Deps)),CD),
607 (CD=[] -> get_preference(dot_definitions_show_all,true) ; true), !,
608 sort(CD,CalledDefs),
609 b_get_definition(DEFID,DefType,Args,_Body,Deps),
610 length(Args,NrArgs),
611 tools:ajoin([DEFID,'/',NrArgs],Desc), % TO DO: improve
612 (get_preference(dot_definitions_use_sub_graph,true) -> SubGraph = DefType ; SubGraph=none),
613 (get_preference(dot_definitions_show_all,true) -> true
614 ; Deps = [_|_] -> true % show if it calls another one
615 ; ord_member(DEFID,CalledDefs) % show if called
616 ),
617 (DefType = predicate -> Color = green ; Color = blue).
618 dot_def_node(0,none,'No DEFINITIONS called',box,none,blue).
619
620 dot_def_trans(NodeID,Label,SuccNodeID,Color,Style) :- Style=solid,
621 b_get_definition(NodeID,_DefType,_Args,_Body,Deps),
622 Label = 'call',
623 member(SuccNodeID,Deps),
624 (Deps = [_] -> Color = black ; Color = blue).
625
626 dot_def_subgraph(SubGraph,filled,lightgray) :-
627 get_preference(dot_definitions_use_sub_graph,true),
628 member(SubGraph,[predicate,expression,substitution]),
629 (b_get_definition(_,SubGraph,_,_,_) -> true).
630
631
632 /* Prediate dependency */
633
634 % call -dotexpr predicate_dependency Pred File
635 % separates a predicate into conjuncts and shows edges between predicates with common variables
636
637 :- use_module(probsrc(tools),[string_escape/2]).
638 :- use_module(probsrc(bsyntaxtree),[predicate_identifiers/2,conjunction_to_list/2]).
639 %
640 tcltk_print_predicate_dependency_as_graph_for_dot(Pred,File) :-
641 my_parse_predicate(Pred,Typed),
642 print_predicate_dependency_as_graph_for_dot(Typed,File).
643
644 :- use_module(probsrc(bmachine), [type_with_errors/4]).
645 :- use_module(probsrc(error_manager), [add_error/3]).
646 my_parse_predicate(RawAST,Typed) :- compound(RawAST),!,
647 type_with_errors(RawAST,[variables],Type,Typed),
648 (Type=pred -> true
649 ; add_error(visualize_graph,'Expected predicate by got:',Type),fail).
650 my_parse_predicate(Pred,Typed) :-
651 atom_codes(Pred,Codes),
652 eval_strings:repl_parse_predicate(Codes,exists,Typed,_).
653
654 :- use_module(dotsrc(dot_graph_generator), [gen_dot_graph/3]).
655 print_predicate_dependency_as_graph_for_dot(Typed,File) :-
656 my_conjunction_to_list(Typed,Conj),
657 get_pred_ids(Conj,1,Preds),
658 gen_dot_graph(File,dot_pred_node(Preds),dot_pred_trans(Preds)).
659
660 my_conjunction_to_list(b(exists(_,Body),pred,_),L) :- !, my_conjunction_to_list(Body,L).
661 my_conjunction_to_list(B,L) :- conjunction_to_list(B,L).
662
663 get_pred_ids([],_,[]).
664 get_pred_ids([Pred|T],N,[pred(N,Pred,Ids)|PT]) :- predicate_identifiers(Pred,Ids),
665 N1 is N+1, get_pred_ids(T,N1,PT).
666
667 dot_pred_node(Preds,PID,none,EDesc,box,none,blue) :- member(pred(PID,Pred,_),Preds),
668 translate:translate_bexpression_with_limit(Pred,Desc),
669 string_escape(Desc,EDesc).
670
671 :- use_module(library(ordsets),[ord_intersection/3]).
672 dot_pred_trans(Preds,NodeID,Label,SuccNodeID,Color,Style) :- Style=solid, Color=black,
673 member(pred(NodeID,_,Ids1),Preds),
674 member(pred(SuccNodeID,_,Ids2),Preds), SuccNodeID>NodeID,
675 ord_intersection(Ids1,Ids2,Label), Label \= [].