add tabling library, update README, make Cargo.toml non-local
This commit is contained in:
Mark Thom
220
src/prolog/lib/tabling/trie.pl
Normal file
220
src/prolog/lib/tabling/trie.pl
Normal file
@@ -0,0 +1,220 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(trie,
|
||||
[ trie_new/1, % -Trie
|
||||
trie_insert/3, % !Trie, +Key, +Value
|
||||
trie_insert_succeed/3,
|
||||
trie_lookup/3, % +Trie, +Key, -Value
|
||||
trie_get_all_values/2 % +Trie, -Value
|
||||
]).
|
||||
|
||||
:- use_module(library(assoc)).
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- attribute maybe_just/1, children/1.
|
||||
|
||||
% Implementation of a prefix tree, a.k.a. trie %
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
% Desired complexity for lookup and insert: linear in the length of the key.
|
||||
|
||||
% ATTENTION: do not use the term functor_data/2; this is used internally here.
|
||||
|
||||
% Inspiration from http://en.wikipedia.org/wiki/Trie
|
||||
|
||||
% Structure of tries:
|
||||
% trie_inner_node(MaybeValue,Children).
|
||||
% where Children is an association list of nonvars to tries.
|
||||
% and where MaybeValue is maybe_none/0 or maybe_just(Value).
|
||||
|
||||
% PRIVATE
|
||||
% For a term of the form p(a,q(b)), "returns" functor_data(p,2) and [a,q(b)].
|
||||
% p_trie_arity_univ(+Term,-FunctorData,-ArgumentsList).
|
||||
p_trie_arity_univ(Term,functor_data(Name,Arity),Arguments) :-
|
||||
Term =.. [Name|Arguments],
|
||||
functor(Term,_,Arity).
|
||||
|
||||
% Returns a new empty trie.
|
||||
trie_new(Trie) :-
|
||||
empty_assoc(Assoc),
|
||||
put_atts(A, children(Assoc)),
|
||||
Trie = trie_inner_node(_,A).
|
||||
|
||||
% Succeeds if given trie does not contain any key-value pair.
|
||||
% trie_is_empty(+Trie)
|
||||
trie_is_empty(trie_inner_node(X,A)) :-
|
||||
get_atts(X, -maybe_just(_)),
|
||||
get_atts(A, children(Assoc)),
|
||||
empty_assoc(Assoc).
|
||||
|
||||
% For internal use.
|
||||
% For now, Children is an association list that can be manipulated using the assoc_ predicates.
|
||||
trie_get_children(trie_inner_node(_,ChildNode),Children) :-
|
||||
get_atts(ChildNode, children(Children)).
|
||||
|
||||
% For internal use.
|
||||
trie_get_maybe_value(trie_inner_node(MaybeNode,_),MaybeValue) :-
|
||||
get_atts(MaybeNode, maybe_just(MaybeValue)).
|
||||
|
||||
% Destructive update of the association list Children.
|
||||
% For internal use.
|
||||
trie_set_children(trie_inner_node(_,ChildNode),Children) :-
|
||||
put_atts(ChildNode, children(Children)).
|
||||
|
||||
trie_set_maybe_value(trie_inner_node(MaybeNode, _),MaybeValue) :-
|
||||
put_atts(MaybeNode, MaybeValue).
|
||||
|
||||
trie_insert_succeed(Trie,Key,Value) :-
|
||||
( trie_insert(Trie,Key,Value) ->
|
||||
true
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
% Succeeds if the term was not present, fails if the term was present.
|
||||
% The term will be present now, whatever the outcome.
|
||||
% We don't use an extra argument to indicate earlier presence, as this increases the trail size.
|
||||
trie_insert(Trie,Key,Value) :-
|
||||
p_trie_arity_univ(Key,FunctorData,KeyList),
|
||||
trie_insert_1(KeyList,FunctorData,Trie,Value).
|
||||
|
||||
trie_insert_1([],FunctorData,Trie,Value) :-
|
||||
trie_get_children(Trie,Assoc),
|
||||
% You need Assoc twice: once to traverse through it, once keeping it as a whole for insertion using put_assoc/4.
|
||||
trie_insert_a(Assoc,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Inline the failure and success continuation to avoid a growing trail stack.
|
||||
trie_insert_1([First|Rest],FunctorData,Trie,Value) :-
|
||||
trie_get_children(Trie,Assoc),
|
||||
% You need Assoc twice: once to traverse through it, once keeping it as a whole for insertion using put_assoc/4.
|
||||
trie_insert_1_1(Assoc,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
% Else part, base case: empty assoc list.
|
||||
trie_insert_a(t,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_new(Subtrie),
|
||||
trie_set_maybe_value(Subtrie,maybe_just(Value)),
|
||||
put_assoc(FunctorData,Assoc,Subtrie,NewAssoc),
|
||||
trie_set_children(Trie,NewAssoc).
|
||||
|
||||
% Then part, nonempty assoc tree.
|
||||
trie_insert_a(t(K,V,_,L,R),Assoc,FunctorData,Trie,Value) :-
|
||||
compare(Rel,FunctorData,K),
|
||||
trie_insert_b(Rel,V,L,R,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Recursively look in the left part of the assoc tree.
|
||||
trie_insert_b(<,_V,L,_R,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_insert_a(L,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Recursively look in the right part of the assoc tree.
|
||||
trie_insert_b(>,_V,_L,R,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_insert_a(R,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
trie_insert_b(=,V,_L,_R,_Assoc,_FunctorData,_Trie,Value) :-
|
||||
trie_get_maybe_value(V,MaybeValue), % V is the Subtrie
|
||||
( MaybeValue == maybe_none ->
|
||||
trie_set_maybe_value(V,maybe_just(Value))
|
||||
% Use true to indicate that the answer was new.
|
||||
;
|
||||
MaybeValue = maybe_just(JustValue),
|
||||
( JustValue == Value ->
|
||||
% Fail to indicate earlier presence
|
||||
fail
|
||||
;
|
||||
throw('trie: attempt to update the value for a key')
|
||||
)
|
||||
).
|
||||
|
||||
% Else part, base case: empty assoc list
|
||||
trie_insert_1_1(t,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Assoc = t, % t is the empty assoc tree
|
||||
trie_new(Subtrie),
|
||||
put_assoc(FunctorData,Assoc,Subtrie,NewAssoc),
|
||||
trie_set_children(Trie,NewAssoc),
|
||||
trie_insert_2(First,Rest,Subtrie,Value).
|
||||
|
||||
% Then part, lookup in assoc list.
|
||||
trie_insert_1_1(t(K,V,_,L,R),Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
compare(Rel,FunctorData,K),
|
||||
trie_insert_1_1_1(Rel,V,L,R,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_1_1_1(=,V,_L,_R,_Assoc,_FunctorData,_Trie,First,Rest,Value) :-
|
||||
trie_insert_2(First,Rest,V,Value). % V is the Subtrie
|
||||
|
||||
trie_insert_1_1_1(<,_V,L,_R,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Look in the left part of the assoc tree.
|
||||
trie_insert_1_1(L,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_1_1_1(>,_V,_L,R,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Look in the right part of the assoc tree.
|
||||
trie_insert_1_1(R,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_2(RegularTerm,Rest,Trie,Value) :-
|
||||
p_trie_arity_univ(RegularTerm,FunctorData,KList),
|
||||
append(KList,Rest,KList2),
|
||||
trie_insert_1(KList2,FunctorData,Trie,Value).
|
||||
|
||||
trie_lookup(Trie,Key,Value) :-
|
||||
p_trie_arity_univ(Key,FunctorData,KeyList),
|
||||
trie_lookup_1(FunctorData,KeyList,Trie,Value).
|
||||
|
||||
trie_lookup_1(FunctorData,Rest,Trie,Value) :-
|
||||
% Select right subtree, fail if it isn't there, and do recursive call.
|
||||
trie_get_children(Trie,Assoc),
|
||||
get_assoc(FunctorData,Assoc,Subtrie), % Fails if not present
|
||||
trie_lookup_2(Rest,Subtrie,Value).
|
||||
|
||||
trie_lookup_2([],Trie,Value) :-
|
||||
% If the value at this trie is maybe_just(X), then X is our Value.
|
||||
% Otherwise, there is no value for this key, so we fail...
|
||||
trie_get_maybe_value(Trie,Value).
|
||||
% Regular term at the head, like p or p(a). Not functor_data/2.
|
||||
trie_lookup_2([RegularTerm|Rest],Trie,Value) :-
|
||||
% split RegularTerm
|
||||
p_trie_arity_univ(RegularTerm,FunctorData,KList),
|
||||
% Make a recursive call on KList ++ Rest.
|
||||
% Since we cannot implement p_trie_arity_univ so that "its result", KList, has a free variable at the end, without resorting to techniques that require linear time, we need a call to append/3. However, since KList will in general be rather short, I don't expect this to be a large problem in practice.
|
||||
append(KList,Rest,KList2),
|
||||
trie_lookup_1(FunctorData,KList2,Trie,Value).
|
||||
|
||||
|
||||
% Returns all values in the trie by backtracking - we don't provide any information about the associated key.
|
||||
trie_get_all_values(Trie,Value) :-
|
||||
trie_get_maybe_value(Trie,Value).
|
||||
trie_get_all_values(Trie,Value) :-
|
||||
trie_get_children(Trie,Children),
|
||||
gen_assoc(_Key, Children, ChildTrie),
|
||||
trie_get_all_values(ChildTrie,Value).
|
||||
Reference in New Issue
Block a user