- 0.0.1
General purpose tracing predicates for Prolog and representation of the search tree by a term.
Used in library(clp)
of pack modeling for implementing a new option trace for labeling/2 predicate.
This library uses global variables trace_search_flag, search_tree_depth and search_tree_prefix, which should not be manipulated.
?- start_tracing, add_node(choice), (add_node(X=f(Y)), X=f(Y), add_node(Y=g(a)), Y=g(a) ; (add_node(X=h(b)), X=h(b))).
X = f(g(a)),
Y = g(a) ;
X = h(b).
?- search_tree_text.
choice
_18984=f(_18980)
_18980=g(a)
_18984=h(b)
true.
Below is an example from library(clp)
of pack modeling with new option trace added to labeling/2 predicate.
?- use_module(library(modeling)).
true.
?- N=4, int_array(Queens, [N], 1..N),
for_all([I in 1..N-1, D in 1..N-I],
(Queens[I] #\= Queens[I+D],
Queens[I] #\= Queens[I+D]+D,
Queens[I] #\= Queens[I+D]-D)),
labeling([ff, trace('Q')], Queens).
N = 4,
Queens = array(2, 4, 1, 3) ;
N = 4,
Queens = array(3, 1, 4, 2) ;
false.
?- search_tree_text.
labeling([Q1,Q2,Q3,Q4])
Q1=1
Q2=3
Q2$\neq$3
Q1$\neq$1
Q1=2
[2,4,1,3]
Q1$\neq$2
Q1=3
[3,1,4,2]
Q1$\neq$3
Q2=1
Q2$\neq$1
true.