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-2020, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(nb_set, 37 [ empty_nb_set/1, % -EmptySet 38 add_nb_set/2, % +Key, !Set 39 add_nb_set/3, % +Key, !Set, ?New 40 gen_nb_set/2, % +Set, -Key 41 size_nb_set/2, % +Set, -Size 42 nb_set_to_list/2 % +Set, -List 43 ]). 44:- autoload(library(lists),[member/2,append/2]). 45:- autoload(library(terms),[term_factorized/3]). 46 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. 59 60@author Jan Wielemaker 61*/ 62 63initial_size(32). % initial hash-table size 64 65%! empty_nb_set(-Set) 66% 67% Create an empty non-backtrackable set. 68 69empty_nb_set(nb_set(Buckets, 0)) :- 70 initial_size(Size), 71 '$filled_array'(Buckets, buckets, Size, []). 72 73%! add_nb_set(+Key, !Set) is det. 74%! add_nb_set(+Key, !Set, ?New) is semidet. 75%! add_nb_set(+Key, !Set, ?New) is semidet. 76% 77% Insert Key into the set. If a variant (see =@=/2) of Key is 78% already in the set, the set is unchanged and New is unified with 79% `false`. Otherwise, New is unified with `true` and a _copy of_ 80% Key is added to the set. 81% 82% @tbd Computing the hash for cyclic terms is performed with 83% the help of term_factorized/3, which performs rather 84% poorly. 85 86add_nb_set(Key, Set) :- 87 add_nb_set(Key, Set, _). 88add_nb_set(Key, Set, New) :- 89 arg(1, Set, Buckets), 90 compound_name_arity(Buckets, _, BCount), 91 hash_key(Key, BCount, Hash), 92 arg(Hash, Buckets, Bucket), 93 ( member(X, Bucket), 94 Key =@= X 95 -> New = false 96 ; New = true, 97 duplicate_term(Key, Copy), 98 nb_linkarg(Hash, Buckets, [Copy|Bucket]), 99 arg(2, Set, Size0), 100 Size is Size0+1, 101 nb_setarg(2, Set, Size), 102 ( Size > BCount 103 -> rehash(Set) 104 ; true 105 ) 106 ). 107 108%! hash_key(+Term, +BucketCount, -Key) is det. 109% 110% Compute a hash for Term. Note that variant_hash/2 currently does 111% not handle cyclic terms, so use term_factorized/3 to get rid of 112% the cycles. This means that this library is rather slow when 113% cyclic terms are involved. 114 115:- if(catch((A = f(A), variant_hash(A,_)), _, fail)). 116hash_key(Term, BCount, Key) :- 117 variant_hash(Term, IntHash), 118 Key is (IntHash mod BCount)+1. 119:- else. 120hash_key(Term, BCount, Key) :- 121 acyclic_term(Key), 122 !, 123 variant_hash(Term, IntHash), 124 Key is (IntHash mod BCount)+1. 125hash_key(Term, BCount, Key) :- 126 term_factorized(Term, Skeleton, Substiution), 127 variant_hash(Skeleton+Substiution, IntHash), 128 Key is (IntHash mod BCount)+1. 129:- endif. 130 131rehash(Set) :- 132 arg(1, Set, Buckets0), 133 compound_name_arity(Buckets0, Name, Arity0), 134 Arity is Arity0*2, 135 '$filled_array'(Buckets, Name, Arity, []), 136 nb_setarg(1, Set, Buckets), 137 nb_setarg(2, Set, 0), 138 ( arg(_, Buckets0, Chain), 139 member(Key, Chain), 140 add_nb_set(Key, Set, _), 141 fail 142 ; true 143 ). 144 145%! nb_set_to_list(+Set, -List) 146% 147% Get the elements of a an nb_set. List is sorted to the standard 148% order of terms. 149 150nb_set_to_list(nb_set(Buckets, _Size), OrdSet) :- 151 compound_name_arguments(Buckets, _, Args), 152 append(Args, List), 153 sort(List, OrdSet). 154 155%! gen_nb_set(+Set, -Key) 156% 157% Enumerate the members of a set in the standard order of terms. 158 159gen_nb_set(Set, Key) :- 160 nb_set_to_list(Set, OrdSet), 161 member(Key, OrdSet). 162 163%! size_nb_set(+Set, -Size) 164% 165% Unify Size with the number of elements in the set 166 167size_nb_set(nb_set(_, Size), Size)