1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2005-2024, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(nb_set, 38 [ empty_nb_set/1, % -EmptySet 39 add_nb_set/2, % +Key, !Set 40 add_nb_set/3, % +Key, !Set, ?New 41 size_nb_set/2, % +Set, -Size 42 nb_set_to_list/2, % +Set, -List 43 gen_nb_set/2 % +Set, -Key 44 ]). 45:- autoload(library(terms), [term_factorized/3]). 46:- use_module(library(debug), [assertion/1]). 47 48/** <module> Non-backtrackable sets 49 50This library provides a non-backtrackabe _set_ of terms that are 51variants of each other. It is primarily intended to implement distinct/1 52from library(solution_sequences). The set is implemented as a hash table 53that is built using non-backtrackable primitives, notably nb_setarg/3. 54 55The original version of this library used binary trees which provides 56immediate ordering. As the trees were not balanced, performance could 57get really poor. The complexity of balancing trees using 58non-backtrackable primitives is too high. The next iteration used _open 59hash tables_, while the current incarnation uses _closed hash tables_, 60providing better perfomance and less space usage. 61 62@author Jan Wielemaker 63*/ 64 65initial_capacity(4). % initial hash-table size 66 67%! empty_nb_set(-Set) 68% 69% Create an empty non-backtrackable set. 70 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). 76 77%! add_nb_set(+Key, !Set) is det. 78%! add_nb_set(+Key, !Set, ?New) is semidet. 79% 80% Insert Key into the set. If a variant (see =@=/2) of Key is 81% already in the set, the set is unchanged and New is unified with 82% `false`. Otherwise, New is unified with `true` and a _copy of_ 83% Key is added to the set. 84% 85% @tbd Computing the hash for cyclic terms is performed with 86% the help of term_factorized/3, which performs rather 87% poorly. 88 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 ). 110 111%! index(+Hash, +Capacity, -Index) is nondet. 112% 113% Generate candidate values for Index, starting from `Hash mod 114% Capacity`, round tripping to 1 when Capacity is reached. 115 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 ). 144 145%! hash_key(+Key, -Hash:integer) is det. 146% 147% Compute a hash for Term. Note that variant_hash/2 currently does 148% not handle cyclic terms, so use term_factorized/3 to get rid of 149% the cycles. This means that this library is rather slow when 150% cyclic terms are involved. 151 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. 164 165%! nb_set_to_list(+NBSet, -OrdSet) is det. 166%! nb_set_to_list(-NBSet, +List) is det. 167% 168% Get the elements of a an nb_set. OrdSet is sorted to the standard 169% order of terms, providing a set representation that is compatible to 170% library(ordsets). 171 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 ). 188 189%! gen_nb_set(+Set, -Key) is nondet. 190% 191% Enumerate the members of a set in the standard order of terms. 192 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). 197 198%! size_nb_set(+Set, -Size) is det. 199% 200% Unify Size with the number of elements in the set 201 202size_nb_set(nb_set(_Empty, _Capacity, Sz, _Buckets), Size) => 203 Size = Sz