diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2012-08-08 04:00:06 +01:00
commit ad609e39da
11 changed files with 161 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
C/gprof.c
View File

@ -213,7 +213,7 @@ static void
LeftRotate(rb_red_blk_node* x) {
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -228,7 +228,7 @@ LeftRotate(rb_red_blk_node* x) {
y=x->right;
x->right=y->left;
if (y->left != nil) y->left->parent=x; /* used to use sentinel here */
if (y->left != rb_nil) y->left->parent=x; /* used to use sentinel here */
/* and do an unconditional assignment instead of testing for nil */
y->parent=x->parent;
@ -270,7 +270,7 @@ static void
RightRotate(rb_red_blk_node* y) {
CACHE_REGS
rb_red_blk_node* x;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -285,7 +285,7 @@ RightRotate(rb_red_blk_node* y) {
x=y->left;
y->left=x->right;
if (nil != x->right) x->right->parent=y; /*used to use sentinel here */
if (rb_nil != x->right) x->right->parent=y; /*used to use sentinel here */
/* and do an unconditional assignment instead of testing for nil */
/* instead of checking if x->parent is the root as in the book, we */
@ -325,12 +325,12 @@ TreeInsertHelp(rb_red_blk_node* z) {
/* This function should only be called by InsertRBTree (see above) */
rb_red_blk_node* x;
rb_red_blk_node* y;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
z->left=z->right=nil;
z->left=z->right=rb_nil;
y=LOCAL_ProfilerRoot;
x=LOCAL_ProfilerRoot->left;
while( x != nil) {
while( x != rb_nil) {
y=x;
if (x->key > z->key) { /* x.key > z.key */
x=x->left;
@ -447,18 +447,18 @@ static rb_red_blk_node*
RBExactQuery(yamop* q) {
CACHE_REGS
rb_red_blk_node* x;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
if (!LOCAL_ProfilerRoot) return NULL;
x=LOCAL_ProfilerRoot->left;
if (x == nil) return NULL;
if (x == rb_nil) return NULL;
while(x->key != q) {/*assignemnt*/
if (x->key > q) { /* x->key > q */
x=x->left;
} else {
x=x->right;
}
if ( x == nil) return NULL;
if ( x == rb_nil) return NULL;
}
return(x);
}
@ -584,11 +584,11 @@ static rb_red_blk_node*
TreeSuccessor(rb_red_blk_node* x) {
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* root=LOCAL_ProfilerRoot;
if (nil != (y = x->right)) { /* assignment to y is intentional */
while(y->left != nil) { /* returns the minium of the right subtree of x */
if (rb_nil != (y = x->right)) { /* assignment to y is intentional */
while(y->left != rb_nil) { /* returns the minium of the right subtree of x */
y=y->left;
}
return(y);
@ -598,7 +598,7 @@ TreeSuccessor(rb_red_blk_node* x) {
x=y;
y=y->parent;
}
if (y == root) return(nil);
if (y == root) return(rb_nil);
return(y);
}
}
@ -624,11 +624,11 @@ RBDelete(rb_red_blk_node* z){
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* x;
rb_red_blk_node* nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* root=LOCAL_ProfilerRoot;
y= ((z->left == nil) || (z->right == nil)) ? z : TreeSuccessor(z);
x= (y->left == nil) ? y->right : y->left;
y= ((z->left == rb_nil) || (z->right == rb_nil)) ? z : TreeSuccessor(z);
x= (y->left == rb_nil) ? y->right : y->left;
if (root == (x->parent = y->parent)) { /* assignment of y->p to x->p is intentional */
root->left=x;
} else {

14
C/heapgc.c
View File

@ -622,7 +622,7 @@ RBTreeCreate(void) {
static void
LeftRotate(rb_red_blk_node* x USES_REGS) {
rb_red_blk_node* y;
rb_red_blk_node* nil=LOCAL_db_nil;
rb_red_blk_node* rb_nil=LOCAL_db_nil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -637,7 +637,7 @@ LeftRotate(rb_red_blk_node* x USES_REGS) {
y=x->right;
x->right=y->left;
if (y->left != nil) y->left->parent=x; /* used to use sentinel here */
if (y->left != rb_nil) y->left->parent=x; /* used to use sentinel here */
/* and do an unconditional assignment instead of testing for nil */
y->parent=x->parent;
@ -678,7 +678,7 @@ LeftRotate(rb_red_blk_node* x USES_REGS) {
static void
RightRotate(rb_red_blk_node* y USES_REGS) {
rb_red_blk_node* x;
rb_red_blk_node* nil=LOCAL_db_nil;
rb_red_blk_node* rb_nil=LOCAL_db_nil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -693,7 +693,7 @@ RightRotate(rb_red_blk_node* y USES_REGS) {
x=y->left;
y->left=x->right;
if (nil != x->right) x->right->parent=y; /*used to use sentinel here */
if (rb_nil != x->right) x->right->parent=y; /*used to use sentinel here */
/* and do an unconditional assignment instead of testing for nil */
/* instead of checking if x->parent is the root as in the book, we */
@ -732,12 +732,12 @@ TreeInsertHelp(rb_red_blk_node* z USES_REGS) {
/* This function should only be called by InsertRBTree (see above) */
rb_red_blk_node* x;
rb_red_blk_node* y;
rb_red_blk_node* nil=LOCAL_db_nil;
rb_red_blk_node* rb_nil=LOCAL_db_nil;
z->left=z->right=nil;
z->left=z->right=rb_nil;
y=LOCAL_db_root;
x=LOCAL_db_root->left;
while( x != nil) {
while( x != rb_nil) {
y=x;
if (x->key < z->key) { /* x.key > z.key */
x=x->left;

2
C/init.c Normal file → Executable file
View File

@ -1368,6 +1368,7 @@ void
Yap_exit (int value)
{
CACHE_REGS
void closeFiles(int all);
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
Yap_unmap_yapor_memory();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
@ -1383,6 +1384,7 @@ Yap_exit (int value)
run_halt_hooks(value);
Yap_ShutdownLoadForeign();
}
closeFiles(TRUE);
exit(value);
}

5
docs/yap.tex
View File

@ -4664,7 +4664,10 @@ will not have a leading dot.
Defines the relation: The stream @var{S} is opened on the file @var{F}
in mode @var{M}. It might be used to obtain all open streams (by
backtracking) or to access the stream for a file @var{F} in mode
@var{M}, or to find properties for a stream @var{S}.
@var{M}, or to find properties for a stream @var{S}. Notice that some
streams might not be associated to a file: in this case YAP tries to
return the file number. If that is not available, YAP unifies @var{F}
with @var(S}.
@item is_stream(@var{S})
@findex is_stream/1

2
packages/CLPBN/Makefile.in
View File

@ -100,7 +100,7 @@ CLPBN_LEARNING_EXAMPLES= \
CLPBN_EXAMPLES= \
$(CLPBN_EXDIR)/burglary-alarm.fg \
$(CLPBN_EXDIR)/burglary-alarm.yap \
$(CLPBN_EXDIR)/burglary-alarm.pfl \
$(CLPBN_EXDIR)/burglary-alarm.uai \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/city.yap \

61
packages/CLPBN/clpbn.yap
View File

@ -16,6 +16,7 @@
op( 500, xfy, with)]).
:- use_module(library(atts)).
:- use_module(library(bhash)).
:- use_module(library(lists)).
:- use_module(library(terms)).
@ -232,7 +233,7 @@ project_attributes(GVars, _AVars0) :-
use_parfactors(on),
clpbn_flag(solver, Solver), Solver \= fove, !,
generate_network(GVars, GKeys, Keys, Factors, Evidence),
call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence, _Avars0).
call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence).
project_attributes(GVars, AVars) :-
suppress_attribute_display(false),
AVars = [_|_],
@ -314,8 +315,62 @@ write_out(fove, GVars, AVars, DiffVars) :-
call_horus_lifted_solver(GVars, AVars, DiffVars).
% call a solver with keys, not actual variables
call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence, Answ) :-
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, Answ).
call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
% traditional solver
b_hash_new(Hash0),
gvars_in_hash(GVars,Hash0, HashI),
keys_to_vars(Keys, AllVars, HashI, Hash1),
evidence_to_vars(Evidence, _EVars, Hash1, Hash),
factors_to_dists(Factors, Hash),
% evidence
retract(use_parfactors(on)),
write_out(Solver, [GVars], AllVars, _),
assert(use_parfactors(on)).
%
% convert a PFL network (without constriants)
% into CLP(BN) for evaluation
%
gvars_in_hash([V|GVars],Hash0, Hash) :-
get_atts(V, [key(K)]),
b_hash_insert(Hash0, K, V, HashI),
gvars_in_hash(GVars,HashI, Hash).
gvars_in_hash([],Hash, Hash).
keys_to_vars([], [], Hash, Hash).
keys_to_vars([K|Keys], [V|Vs], Hash0, Hash) :-
b_hash_lookup(K, V, Hash0), !,
keys_to_vars(Keys, Vs, Hash0, Hash).
keys_to_vars([K|Keys], [V|Vs],Hash0, Hash) :-
b_hash_insert(Hash0, K, V, HashI),
keys_to_vars(Keys, Vs, HashI, Hash).
evidence_to_vars([], [], Hash, Hash).
evidence_to_vars([K=E|Keys], [V|Vs], Hash0, Hash) :-
b_hash_lookup(K, V, Hash0), !,
clpbn:put_atts(V,[evidence(E)]),
evidence_to_vars(Keys, Vs, Hash0, Hash).
evidence_to_vars([K=E|Keys], [V|Vs],Hash0, Hash) :-
b_hash_insert(Hash0, K, V, HashI),
clpbn:put_atts(V,[evidence(E)]),
evidence_to_vars(Keys, Vs, HashI, Hash).
factors_to_dists([], _Hash).
factors_to_dists([f(bayes,_Id,Ks,CPT)|Factors], Hash) :-
keys_to_vars(Ks, Hash, [V|Parents]),
Ks =[Key|_],
pfl:skolem(Key, Domain),
dist(p(Domain,CPT,Parents), DistInfo, Key, Parents),
put_atts(V,[dist(DistInfo,Parents)]),
factors_to_dists(Factors, Hash).
keys_to_vars([], _Hash, []).
keys_to_vars([K|Ks], Hash, [V|Vs]) :-
b_hash_lookup(K,V,Hash),
keys_to_vars(Ks, Hash, Vs).
get_bnode(Var, Goal) :-

73
packages/CLPBN/clpbn/horus_ground.yap
View File

@ -58,20 +58,21 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Outpu
call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidence, Solutions) :-
attributes:all_attvars(AVars),
keys(AVars, AllKeys),
writeln(AllKeys),
b_hash_new(Hash0),
keys_to_ids(AllKeys, 0, Hash0, Hash),
keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1),
get_factors_type(Factors, Type),
evidence_to_ids(Evidence, Hash, EvidenceIds),
factors_to_ids(Factors, Hash, FactorIds),
evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds),
factors_to_ids(Factors, Hash2, Hash, Id2, _, FactorIds),
writeln(queryKeys:QueryKeys), writeln(''),
writeln(type:Type), writeln(''),
writeln(allKeys:AllKeys), writeln(''),
sort(AllKeys,SKeys),writeln(allSortedKeys:SKeys), writeln(''),
keys_to_ids(SKeys, 0, Hash0, Hash),
writeln(factors:Factors), writeln(''),
writeln(factorIds:FactorIds), writeln(''),
writeln(evidence:Evidence), writeln(''),
writeln(evidenceIds:EvidenceIds), writeln(''),
keys_to_ids(SKeys, 0, _, Hash0, Hash),
% writeln(factors:Factors), writeln(''),
% writeln(factorIds:FactorIds), writeln(''),
% writeln(evidence:Evidence), writeln(''),
% writeln(evidenceIds:EvidenceIds), writeln(''),
cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network),
get_vars_information(AllKeys, StatesNames),
terms_to_atoms(AllKeys, KeysAtoms),
@ -91,51 +92,59 @@ keys([_V|AVars], AllKeys) :-
run_solver(ground(Network,Hash), QueryKeys, Solutions) :-
%get_dists_parameters(DistIds, DistsParams),
%cpp_set_factors_params(Network, DistsParams),
list_of_keys_to_ids(QueryKeys, Hash, QueryIds),
list_of_keys_to_ids(QueryKeys, Hash, _, _, _, QueryIds),
%writeln(queryKeys:QueryKeys), writeln(''),
%writeln(queryIds:QueryIds), writeln(''),
cpp_run_ground_solver(Network, [QueryIds], Solutions).
keys_to_ids([], _, Hash, Hash).
keys_to_ids([Key|AllKeys], I0, Hash0, Hash) :-
keys_to_ids([], Id, Id, Hash, Hash).
keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
b_hash_insert(Hash0, Key, I0, HashI),
I is I0+1,
keys_to_ids(AllKeys, I, HashI, Hash).
I1 is I0+1,
keys_to_ids(AllKeys, I1, I, HashI, Hash).
get_factors_type([f(bayes, _, _, _)|_], bayes) :- ! .
get_factors_type([f(markov, _, _, _)|_], markov) :- ! .
list_of_keys_to_ids([], _, []).
list_of_keys_to_ids([List|Extra], Hash, [IdList|More]) :-
list_of_keys_to_ids([], H, H, I, I, []).
list_of_keys_to_ids([List|Extra], Hash0, Hash, I0, I, [IdList|More]) :-
List = [_|_], !,
list_of_keys_to_ids(List, Hash, IdList),
list_of_keys_to_ids(Extra, Hash, More).
list_of_keys_to_ids([Key|QueryKeys], Hash, [Id|QueryIds]) :-
b_hash_lookup(Key, Id, Hash),
list_of_keys_to_ids(QueryKeys, Hash, QueryIds).
list_of_keys_to_ids(List, Hash0, Hash1, I0, I1, IdList),
list_of_keys_to_ids(Extra, Hash1, Hash, I1, I, More).
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [Id|QueryIds]) :-
b_hash_lookup(Key, Id, Hash0), !,
list_of_keys_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [I0|QueryIds]) :-
b_hash_insert(Hash0, Key, I0, Hash1),
I1 is I0+1,
list_of_keys_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
factors_to_ids([], _, []).
factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
list_of_keys_to_ids(Keys, Hash, Ids),
get_ranges(Keys, Ranges),
factors_to_ids(Fs, Hash, NFs).
factors_to_ids([], H, H, I, I, []).
factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash0, Hash, I0, I, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
list_of_keys_to_ids(Keys, Hash0, Hash1, I0, I1, Ids),
get_ranges(Keys, Ranges),
factors_to_ids(Fs, Hash1, Hash, I1, I, NFs).
get_ranges([],[]).
get_ranges(K.Ks, Range.Rs) :- !,
skolem(K,Domain),
length(Domain,Range),
get_ranges(Ks, Rs).
skolem(K,Domain),
length(Domain,Range),
get_ranges(Ks, Rs).
evidence_to_ids([], _, []).
evidence_to_ids([Key=Ev|QueryKeys], Hash, [Id=Ev|QueryIds]) :-
b_hash_lookup(Key, Id, Hash),
evidence_to_ids(QueryKeys, Hash, QueryIds).
evidence_to_ids([], H, H, I, I, []).
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [Id=Ev|QueryIds]) :-
b_hash_lookup(Key, Id, Hash0),
evidence_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [I=Ev|QueryIds]) :-
b_hash_insert(Hash0, Key, I0, Hash1),
I1 is I0+1,
evidence_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
get_vars_information([], []).

3
packages/CLPBN/clpbn/ve.yap
View File

@ -102,9 +102,8 @@ solve_ve([LVs|_], [NVs0|_], Ps) :-
sort(LV0, LV),
% construct the graph
find_all_table_deps(Tables0, LV),
%writeln((Li: LVs: LV)),
process(LVi, LVs, tab(Dist,_,_)),
%writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
%exps(LD,LDE),writeln(LDE),
% move from potentials back to probabilities
normalise_CPT(Dist,MPs),

0
packages/CLPBN/examples/burglary-alarm.yap → packages/CLPBN/examples/burglary-alarm.pfl
View File

17
pl/boot.yap
View File

@ -518,14 +518,17 @@ true :- true.
% *-> at this point would require compiler support, which does not exist.
%
'$delayed_goals'(G, V, NV, LGs, NCP) :-
if(
(yap_hacks:current_choice_point(NCP1),
(
CP is '$last_choice_pt',
yap_hacks:current_choice_point(NCP1),
'$attributes':delayed_goals(G, V, NV, LGs),
yap_hacks:current_choice_point(NCP2))
,
(NCP is NCP2-NCP1)
,
(copy_term_nat(V, NV), LGs = [], NCP = 0)
yap_hacks:current_choice_point(NCP2),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
;
copy_term_nat(V, NV),
LGs = [],
NCP = 0
).
'$out_neg_answer' :-

22
pl/yio.yap
View File

@ -98,6 +98,16 @@ socket(Domain, Type, Protocol, Sock) :-
),
yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
socket_connect(Sock, Host, Read) :-
(
'$undefined'(ip_socket(_,_),yap_sockets)
->
load_files(library(sockets), [silent(true),if(not_loaded)])
;
true
),
yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
open_pipe_streams(Read, Write) :-
(
'$undefined'(pipe(_,_),unix)
@ -263,6 +273,7 @@ current_line_number(Stream,N) :-
stream_position(Stream, Position) :-
stream_property(Stream, position(Position)).
stream_position(Stream, Position, NewPosition) :-
stream_property(Stream, position(Position)),
set_stream_position(Stream, NewPosition).
@ -292,8 +303,15 @@ current_char_conversion(X,Y) :-
'$fetch_char_conversion'(List,X,Y).
current_stream(File, Opts, Stream) :-
'$current_stream'(File, Opts, Stream).
current_stream(File, Mode, Stream) :-
stream_property(Stream, mode(Mode)),
'$stream_name'(Stream, File).
'$stream_name'(Stream, File) :-
stream_property(Stream, file_name(File)), !.
'$stream_name'(Stream, file_no(File)) :-
stream_property(Stream, file_no(File)), !.
'$stream_name'(Stream, Stream).
'$extend_file_search_path'(P) :-
atom_codes(P,S),