Did you know ... Search Documentation:
Pack pac -- prolog/zdd/zdd-array.pl
PublicShow source
 hash_memochk(+X, +H)
true if X exists in the hash H, otherwise fails.
 hash_memoadd(+X, +H) is det
add X to the hash table H. Remark: it does not check that X is not in H.
 open_state is det
open a new state. ?- open_state, show_state, bdd_cons(I, a, 1), psa(I), bdd_cons(J, b, I), psa(J).
 show_array is det
The same as show_array(zdd_node). ! show_array(+G) is det. Print all triples in array bound to G.
 memo(+A, +G) is det
A = X-V. The input pair X-V is unified with with a member of a bucket of the hash table of the state S. Otherwise, create a new entry for X-V.
 insert_memo(+Key, +X) is det
Insert X in the zdd associated with the Key when the Key entry exists, otherwise the zdd is assumed to be 1.
 pred_memo_update(+Pred, U) is det
U = K-V Replace the pair K-L0 with K-L, where L is obtained by applying Pred to V, L0, by calling Pred(V, L0, L).
 memoq(U) is det
with U = X-V, Check V with the value of key X compared by == stored in the hash table of S. ?- push_memo, memo(a-b), memoq(a-Y). % fail. ?- push_memo, memo(a-b), memoq(a-b). % true
 index(?I, +Array, ?Elem) is det
Array = #(J, Vec). If I is bound, then I-th arg of Vec must be exists, and the I-th arg of Vec is unified with Elem. When I is unbound, Vec is extended by double if necessary, and I is unified with new position of arg of Vec for Elem such that arg(I, Vec, Elem) is true.
 xarg(I, A) is det
is equivalent to xarg(I, A, _).
 xsetarg(+I, +A, ?X) is det
A must be of thform f(Vec). % default f should #. Fails If I is greater than the size the Vec. othewise, setarg(I, Vec, X).
 array_index(?I, +Array, ?X) is det
I: integer > 0, X : any term I-th element of Array is unifified with X. If I is unbund, I will unifiied with a new entry id of the Array, ` and when the Array is full, it is extended by double. Similar to xarg for vector, but for array instead. vector has not counter for max entry, but does array.
 close_hash(+H) is det
close hash table H, to be reclaimed later.
 hash(+X, +H, ?E) is det
Put a key-value term X-E on the hash table H. ! hash_scan(+X, +Y, ?Val)
 cofact(?X, ?T, +State) is det
T = 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).

 iterm(?I, ?X) is det
The default core state is assumed. If I is unbound then, X must be a ground term, and I is unified with a unique id number of X. If I is an integer >0, X is unified with a term whose id number is I. Note that each element of used args of array is always a unique ground term.
 iterm(?I, ?X, +AH) is det
AH is a core state. Using the array and hash bound to AH, if I is unbound then X must be a ground term, and I is unified with a unique id number of X. If I is an integer >0, X is unified with a term whose id number is I. Note that each element of used args of array is always a unique ground term.
 slim_gc(+X, -Y) is det
Do slim_iterms(X, Y), and call garbage_collect.
 pred_slim_gc(+X, -Y, +F) is det
Do slim_iterms(X, Y, F), and call garbage_collect, where F is predicate such that call(F, A, B, V).

Undocumented predicates

The following predicates are exported, but not or incorrectly documented.

 open_state(Arg1)
 close_state
 initial_basic_state(Arg1, Arg2)
 open_basic_state(Arg1)
 open_basic_state(Arg1, Arg2)
 open_array(Arg1)
 open_array(Arg1, Arg2)
 open_array_gvar(Arg1)
 open_array_gvar(Arg1, Arg2)
 open_array_hash(Arg1, Arg2)
 open_vector(Arg1, Arg2)
 open_hash(Arg1)
 open_hash(Arg1, Arg2)
 open_hash_gvar(Arg1)
 open_hash_gvar(Arg1, Arg2)
 close_array(Arg1)
 memo(Arg1)
 init_memo_stack
 zdd_dict_memo(Arg1)
 zdd_dict_memo(Arg1, Arg2)
 get_assoc(Arg1, Arg2)
 memo_index(Arg1, Arg2)
 key_assert(Arg1, Arg2)
 key_exists(Arg1, Arg2)
 numbering(Arg1, Arg2)
 set_counter(Arg1)
 set_counter(Arg1, Arg2)
 biject(Arg1, Arg2, Arg3)
 push_memo
 pop_memo
 use_memo(Arg1)
 reset_memo_call(Arg1)
 open_memo(Arg1)
 open_memo(Arg1, Arg2)
 close_memo(Arg1)
 open_hash(Arg1, Arg2)
 open_zdd_dict
 open_zdd_dict(Arg1)
 open_zdd_dict(Arg1, Arg2)
 zdd_dict(Arg1, Arg2, Arg3)
 zdd_dict(Arg1, Arg2, Arg3, Arg4)
 set_memo(Arg1)
 update_memo(Arg1, Arg2)
 dump_memo
 dump_memo(Arg1)
 dump_hash(Arg1)
 unify_args(Arg1, Arg2, Arg3)
 xarg(Arg1, Arg2, Arg3)
 add_child(Arg1, Arg2)
 add_child(Arg1, Arg2, Arg3)
 cofact(Arg1, Arg2)
 term(Arg1, Arg2)
 show_state
 index_elem(Arg1, Arg2, Arg3)
 iterm_hash(Arg1, Arg2)
 iterm_hash(Arg1, Arg2, Arg3)
 slim_iterm(Arg1, Arg2, Arg3)
 slim_iterms(Arg1, Arg2, Arg3)