36
37:- module(nb_set,
38 [ empty_nb_set/1, 39 add_nb_set/2, 40 add_nb_set/3, 41 size_nb_set/2, 42 nb_set_to_list/2, 43 gen_nb_set/2 44 ]). 45:- autoload(library(terms), [term_factorized/3]). 46:- use_module(library(debug), [assertion/1]).
65initial_capacity(4).
71empty_nb_set(NbSet) :-
72 initial_capacity(Capacity),
73 Empty = empty(1),
74 '$filled_array'(Buckets, buckets, Capacity, Empty),
75 NbSet = nb_set(Empty, Capacity, 0, Buckets).
89add_nb_set(Key, Set) :-
90 add_nb_set(Key, Set, _).
91add_nb_set(Key, Set, New) :-
92 Set = nb_set(Empty, Capacity, Size, Buckets),
93 key_hash(Key, Hash),
94 index(Hash, Capacity, KIndex),
95 arg(KIndex, Buckets, StoredKey),
96 ( same_term(StoredKey, Empty)
97 -> !,
98 New = true,
99 nb_setarg(KIndex, Buckets, Key),
100 NSize is Size+1,
101 nb_setarg(3, Set, NSize),
102 ( NSize > Capacity//2
103 -> rehash(Set)
104 ; true
105 )
106 ; Key =@= StoredKey
107 -> !,
108 New = false
109 ).
116index(Hash, Capacity, KIndex) :-
117 KIndex0 is (Hash mod Capacity) + 1,
118 next(KIndex0, Capacity, KIndex).
119
120next(KIndex, _, KIndex).
121next(KIndex0, Capacity, KIndex) :-
122 KIndex1 is 1+(KIndex0 mod Capacity),
123 next(KIndex1, Capacity, KIndex).
124
125rehash(Set) :-
126 Set = nb_set(Empty, Capacity, Size, Buckets),
127 NCapacity is Capacity*2,
128 '$filled_array'(NBuckets, buckets, NCapacity, Empty),
129 nb_setarg(2, Set, NCapacity),
130 nb_setarg(3, Set, 0),
131 nb_linkarg(4, Set, NBuckets),
132 forall(between(1, Capacity, I),
133 reinsert(I, Empty, Buckets, Set)),
134 arg(3, Set, NewSize),
135 assertion(NewSize == Size).
136
137:- det(reinsert/4). 138reinsert(KIndex, Empty, Buckets, Set) :-
139 arg(KIndex, Buckets, Key),
140 ( same_term(Key, Empty)
141 -> true
142 ; add_nb_set(Key, Set, true)
143 ).
152:- if(catch((A = f(A), variant_hash(A,_)), _, fail)). 153key_hash(Key, Hash) :-
154 variant_hash(Key, Hash).
155:- else. 156key_hash(Key, Hash) :-
157 acyclic_term(Key),
158 !,
159 variant_hash(Key, Hash).
160key_hash(Key, Hash) :-
161 term_factorized(Key, Skeleton, Substiution),
162 variant_hash(Skeleton+Substiution, Hash).
163:- endif.
172nb_set_to_list(NBSet, Set),
173 NBSet = nb_set(Empty, Capacity, _Size, Buckets) =>
174 buckets_to_list(1, Empty, Capacity, Buckets, List0),
175 sort(List0, Set).
176
177buckets_to_list(KIndex, Empty, Capacity, Buckets, List) :-
178 ( arg(KIndex, Buckets, Key)
179 -> ( same_term(Empty, Key)
180 -> KIndex1 is KIndex+1,
181 buckets_to_list(KIndex1, Empty, Capacity, Buckets, List)
182 ; List = [Key|List1],
183 KIndex1 is KIndex+2,
184 buckets_to_list(KIndex1, Empty, Capacity, Buckets, List1)
185 )
186 ; List = []
187 ).
193gen_nb_set(nb_set(Empty, Capacity, _Size, Buckets), Key) =>
194 between(1, Capacity, KIndex),
195 arg(KIndex, Buckets, Key),
196 \+ same_term(Empty, Key).
202size_nb_set(nb_set(_Empty, _Capacity, Sz, _Buckets), Size) =>
203 Size = Sz
Non-backtrackable sets
This library provides a non-backtrackabe set of terms that are variants of each other. It is primarily intended to implement distinct/1 from library(solution_sequences). The set is implemented as a hash table that is built using non-backtrackable primitives, notably nb_setarg/3.
The original version of this library used binary trees which provides immediate ordering. As the trees were not balanced, performance could get really poor. The complexity of balancing trees using non-backtrackable primitives is too high. The next iteration used open hash tables, while the current incarnation uses closed hash tables, providing better perfomance and less space usage.