Did you know ... | Search Documentation: |
![]() | Pack pac -- prolog/zdd/zdd-array.pl |
bdd_cons(I, a, 1)
, psa(I)
, bdd_cons(J, b, I)
, psa(J)
.show_array(zdd_node)
.
! show_array(+G)
is det.
Print all triples in array bound to G.==
stored in the hash table of S.
?- push_memo, memo(a-b)
, memoq(a-Y)
. % fail.
?- push_memo, memo(a-b)
, memoq(a-b)
. % truearg(I, Vec, Elem)
is true.xarg(I, A, _)
.f(Vec)
. % default f should #.
Fails If I is greater than the size the Vec.
othewise, setarg(I, Vec, X)
.t(A, L, R)
Bidirectional.
X is unified with the index of a triple C, or
C is unified with the triple t/3 stored at index X of the array.
It is explained in terms of famiy of sets as follows.
If X is given then
Y is a triple t(A, L, R)
such that
A is the minimum atom in X w.r.t specified compare predicate,
L = { U in X | not ( A in U ) },
R = { V \ {A} | V in X, A in V }.
If Y is given then
X = union of L and { unionf of U and {A} | U in R }.
Non standard use of cofact/3 is possible keeping the structure sharing, but withoug zero_suppress rule. IMO the rule is only meaningful under family of sets semantics for the empty family {} of sets.
?- X <<{[a,b,d]}, cofact(X, T)
.
?- X <<{[a]}, show_state, b_getval(zdd_node, Vec)
, write(Vec)
.
?- cofact(X, a)
, cofact(Y, b)
, cofact(Z, f(X, Y))
,
cofact(Z, C)
, cofact(X, A)
, cofact(Y, B)
.
slim_iterms(X, Y)
, and call garbage_collect.slim_iterms(X, Y, F)
, and call garbage_collect,
where F is predicate such that call(F, A, B, V)
.The following predicates are exported, but not or incorrectly documented.