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

Problog testing: modules :(

This commit is contained in:
Vitor Santos Costa 2019-05-27 15:32:39 +01:00
parent 07cd79ccb7
commit ef8e9a2ea3
17 changed files with 82 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
H/Yapproto.h
View File

@ -175,6 +175,7 @@ extern int Yap_DBTrailOverflow(void);
extern CELL Yap_EvalMasks(Term, CELL *);
extern void Yap_InitBackDB(void);
extern void Yap_InitDBPreds(void);
extern void Yap_InitDBLoadPreds(void);
/* errors.c */
#if DEBUG

6
H/absmi.h
View File

@ -31,6 +31,12 @@
#define register
#endif
#if TABLING
#define FROZEN_STACKS 1
//#define MULTIPLE_STACKS 1
#endif
/***************************************************************
* Macros for register manipulation *
***************************************************************/

1
H/amidefs.h
View File

@ -48,6 +48,7 @@ typedef struct regstore_t *regstruct_ptr;
#endif
typedef Int (*CPredicate)(CACHE_TYPE1);
typedef Int (*CmpPredicate)(Term, Term);

53
H/trim_trail.h
View File

@ -1,17 +1,17 @@
#ifdef FROZEN_STACKS
#define RESET_TRAIL_ENTRY(pt) { TrailTerm(pt) = (CELL)(pt); TrailVal(pt) = (CELL)(pt); }
{
tr_fr_ptr pt0, pt1, pbase, ptop;
pbase = B->cp_tr, ptop = TR;
pt0 = pt1 = TR - 1;
tr_fr_ptr pt1, pbase;
pbase = B->cp_tr;
pt1 = TR - 1;
while (pt1 >= pbase) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
if (d1 >= (CELL)HBREG && d1 < Unsigned(HR)) {
RESET_TRAIL_ENTRY(pt1);
}
pt1--;
} else if (IsPairTerm(d1)) {
@ -28,14 +28,14 @@
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
} else if (IN_BETWEEN(H0, pt, LCL0) && IsApplTerm(HeadOfTerm(d1))) {
Term t = HeadOfTerm(d1);
Functor f = FunctorOfTerm(t);
if (f == FunctorBigInt) {
Int tag = Yap_blob_tag(t);
GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else {
pt0--;
RESET_TRAIL_ENTRY(pt1);
}
pt1--;
continue;
@ -48,6 +48,7 @@
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
RESET_TRAIL_ENTRY(pt1);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask | DirtyMask)) && !(cl->ClRefCount);
if (erase) {
@ -59,43 +60,23 @@
Yap_CleanUpIndex(cl);
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG, RepAppl(d1), B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
RESET_TRAIL_ENTRY(pt1);
pt1--;
RESET_TRAIL_ENTRY(pt1);
/* deterministic binding to multi-assignment variable */
pt1 --;
} else {
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0 - 1) = TrailVal(pt1 - 1);
TrailTerm(pt0 - 1) = TrailTerm(pt1 - 1);
pt0 -= 2;
pt1 -= 2;
}
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
pt1--;
pt1--;
}
ENDD(d1);
}
if (pt0 != pt1) {
int size;
pt0++;
size = ptop - pt0;
memmove(pbase, pt0, size * sizeof(struct trail_frame));
if (ptop != TR) {
memmove(pbase + size, ptop, (TR - ptop) * sizeof(struct trail_frame));
size += (TR - ptop);
}
TR = pbase + size;
}
}
#else
{

2
packages/ProbLog/problog.yap
View File

@ -845,7 +845,7 @@ term_expansion_intern(Head :: Goal,Module,problog:ProbFact) :-
% handles probabilistic facts
term_expansion_intern(P :: Goal,Module,problog:ProbFact) :-
copy_term((P,Goal),(P_Copy,Goal_Copy)),
copy_term((P,Goal),(P_Copy,Goal_Copy)),
functor(Goal, Name, Arity),
atomic_concat([problog_,Name],ProblogName),
Goal =.. [Name|Args],

3
packages/ProbLog/problog/lbdd.yap
View File

@ -91,6 +91,7 @@ gradient(QueryID, g, Slope) :-
query_probabilities( DBDD, Prob) :-
DBDD = bdd(Dir, Tree, _MapList),
findall(P, evalp(Tree,P), [Prob0]),
% nonvar(Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
evalp( Tree, Prob0) :-
@ -104,7 +105,7 @@ query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :-
evalp( pn(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*(1.0-PR).
evalp( pp(P, _-X, PL, PR), _,P ):-
evalp( pp(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*PR.
evalg( I, pp(P-G, J-X, L, R), _, G ):-

14
packages/ProbLog/problog_examples/learn_graph_lbdd.pl
View File

@ -14,20 +14,9 @@
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module('../problog_lbfgs').
:- use_module('../problog_learning_lbdd').
:- if(true).
:- use_module('kbgraph').
%%%%
% background knowledge
%%%%
% definition of acyclic path using list of visited nodes
:- else.
:- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
@ -48,7 +37,6 @@ edge(X,Y) :- dir_edge(X,Y).
absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
%%%%
% probabilistic facts

29
packages/ProbLog/problog_lbfgs.yap
View File

@ -553,7 +553,7 @@ empty_bdd_directory.
init_queries :-
empty_bdd_directory,
format_learning(2,'Build BDDs for examples~n',[]),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)).
bdd_input_file(Filename) :-
@ -835,7 +835,7 @@ update_values :-
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)),
retractall(query_gradient_intern(_,_,_,_)),
assertz(values_correct).
@ -847,7 +847,7 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error,
N1 is N-1,
forall(between(0,N1,I),(Grad[I]<==0.0)),
@ -893,13 +893,11 @@ compute_gradient( Grad, X, Slope, LL) :-
BDD = bdd(_,_,MapList),
MapList = [_|_],
bind_maplist(MapList, Slope, X),
%writeln(QueryID:MapList),
query_probabilities( BDD, BDDProb),
(isnan(BDDProb) -> writeln((nan::QueryID)), fail;true),
writeln(BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
forall(
query_gradients(BDD,I,IProb,GradValue),
query_gradients(BDD,I,IProb,GradValue),
gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb)
).
@ -925,8 +923,9 @@ wrap( _X, _Grad, _GradCount).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :-
FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]).
format('Bad FX=~4f~n',[FX]).
user:progress(FX,X,G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :-
writeln(fx=FX),
problog_flag(sigmoid_slope,Slope),
save_state(X, Slope, G),
logger_set_variable(mse_trainingset, FX),
@ -946,22 +945,6 @@ save_state(X,Slope,_Grad) :-
tunable_fact(FactID,_GroundTruth),
set_tunable(FactID,Slope,X),
fail.
save_state(X, Slope, _) :-
user:example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(X, Slope, _) :-
user:test_example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(_X, _Slope, _).
%========================================================================

3
packages/ProbLog/problog_learning.yap
View File

@ -710,7 +710,7 @@ update_values :-
%=
%========================================================================
listing(
update_query_cleanup(QueryID) :-
(
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
->
@ -893,7 +893,6 @@ ground_truth_difference :-
%=
%= -Float
%========================================================================
mse_trainingset_only_for_linesearch(MSE) :-
update_values,

1
packages/ProbLog/problog_learning_lbdd.yap
View File

@ -228,6 +228,7 @@
:- use_module('problog/utils_lbdd').
:- use_module('problog/utils').
:- use_module('problog/tabling').
:- use_module('problog/lbdd').
% used to indicate the state of the system
:- dynamic(values_correct/0).

4
packages/yap-lbfgs/lbfgs.pl
View File

@ -24,6 +24,7 @@
lbfgs_initialize/4,
lbfgs_run/3,
lbfgs_fx/1,
lbfgs_finalize/1,
lbfgs_set_parameter/2,
@ -180,7 +181,8 @@ lbfgs_finalize(_N).
run the algorithm. output the final score of the function being optimised
*/
lbfgs_run(N,X,FX) :-
lbfgs(N,X, FX).
lbfgs(N,X),
lbfgs_fx(FX).

26
packages/yap-lbfgs/yap_lbfgs.c
View File

@ -35,7 +35,7 @@ X_API void init_lbfgs_predicates(void);
YAP_Functor fevaluate, fprogress, fmodule, ffloats;
YAP_Term tuser;
lbfgsfloatval_t *x_p;
lbfgsfloatval_t *x_p, f_x;
static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
lbfgsfloatval_t *g_tmp, const int n,
@ -43,7 +43,7 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
YAP_Term call;
YAP_Bool result;
lbfgsfloatval_t rc=0.0;
YAP_Term v=YAP_MkVarTerm(), t1, t12;
YAP_Term t12;
YAP_Term t[6], t2[2];
YAP_Term t_0 = YAP_MkIntTerm((YAP_Int)&rc);
@ -60,8 +60,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
t2[1] = YAP_MkApplTerm(fevaluate, 6, t);
call = YAP_MkApplTerm(fmodule, 2, t2);
int sl = YAP_InitSlot(v);
// lbfgs_status=LBFGS_STATUS_CB_EVAL;
result = YAP_RunGoalOnce(call);
// lbfgs_status=LBFGS_STATUS_RUNNING;
@ -72,8 +70,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
return FALSE;
}
YAP_ShutdownGoal(true);
YAP_RecoverSlots(1, sl);
fprintf(stderr,"%gxo\n",rc);
return rc;
}
@ -183,7 +179,7 @@ value will terminate the optimization process.
*/
static YAP_Bool p_lbfgs(void) {
YAP_Term t1 = YAP_ARG1, t;
int n, sl;
int n;
lbfgsfloatval_t *x;
lbfgsfloatval_t fx;
@ -196,7 +192,6 @@ static YAP_Bool p_lbfgs(void) {
if (n < 1) {
return FALSE;
}
sl = YAP_InitSlot(YAP_ARG3);
if (!x_p)
x_p = lbfgs_malloc(n+1);
@ -206,15 +201,17 @@ static YAP_Bool p_lbfgs(void) {
lbfgs_parameter_t *param = &parms;
void *ui = NULL; //(void *)YAP_IntOfTerm(YAP_ARG4);
int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param);
t = YAP_GetFromSlot(sl);
YAP_Unify(t, YAP_MkFloatTerm(fx));
YAP_RecoverSlots(1, sl);
if (ret == 0)
f_x = fx;
if (ret == 0)
return true;
fprintf(stderr, "optimization terminated with code %d\n ",ret);
return true;
}
static YAP_Bool lbfgs_fx(void) {
return YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(f_x));
}
static YAP_Bool lbfgs_grab(void) {
int n = YAP_IntOfTerm(YAP_ARG1);
@ -468,8 +465,9 @@ X_API void init_lbfgs_predicates(void) {
lbfgs_parameter_init(&parms);
YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 3);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("lbfgs", p_lbfgs, 2);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("lbfgs_fx", lbfgs_fx, 1);
YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0);

2
pl/consult.yap
View File

@ -1011,7 +1011,7 @@ prolog_load_context(file, FileName) :-
).
prolog_load_context(module, X) :-
'__NB_getval__'('$consulting_file', _, fail),
'current_module'(X).
current_source_module(X,X).
prolog_load_context(source, F0) :-
( source_location(F0, _) /*,
'$input_context'(Context),

22
pl/imports.yap
View File

@ -35,20 +35,17 @@ fail.
% parent module mechanism
%% system has priority
'$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
nonvar(G),
'$pred_exists'(G,prolog).
nonvar(G).
%% I am there, no need to import
'$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
nonvar(Pred),
'$pred_exists'(Pred, Mod).
nonvar(Pred).
%% export table
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_).
%% parent/user
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
'$get_predicate_definition'(ImportingMod:G,PMod:G) :-
( '$parent_module'(ImportingMod, PMod) ; PMod = user ),
ImportingMod \= PMod,
'$get_predicate_definition'(PMod:G, ExportingMod:G0).
ImportingMod \= PMod.
%% autoload`
%'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
% current_prolog_flag(autoload, true),
@ -57,22 +54,25 @@ fail.
'$predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
'$pred_exists'(NPred,Exp),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$one_predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
'$get_predicate_definition'(Imp:Pred,[],Exp:NPred),
'$pred_exists'(NPred,Exp),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$one_predicate_definition'(Exp:Pred,Exp:Pred).
'$predicate_definition'(M0:Pred0,Path,ModF:PredF) :-
'$get_predicate_definition'(M0:Pred0, Mod:Pred),
\+ lists:member(Mod:Pred,Path),
(
'$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF)
'$pred_exists'(Pred,Mod), Mod = ModF, Pred = PredF
;
Mod = ModF, Pred = PredF
\+ lists:member(Mod:Pred,Path),
'$predicate_definition'(Mod:Pred,[Mod:Pred|Path], ModF:PredF)
).
%

4
pl/meta.yap
View File

@ -405,6 +405,10 @@ meta_predicate(P) :-
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_goals'(forall(A,B), forall(A1,B1),
(A0 , ( B0 -> fail ; true ) -> fail; true ),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A*->B;C),(A1*->B1;C1),
('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),

2
pl/preds.yap
View File

@ -490,7 +490,7 @@ current_predicate(A0,T0) :-
'$current_predicate'(A,M,T,_),
functor(T, A, _)
;
'$get_predicate_definition'(M:T,M1:_T1),
'$predicate_definition'(M:T,M1:_T1),
M\=M1,
functor(T, A, _)
).

17
pl/top.yap
View File

@ -602,7 +602,7 @@ write_query_answer( Bindings ) :-
expand_goal(M:G, NG),
must_be_callable(NG),
'$yap_strip_module'(NG,NM,NC),
'$yap_strip_module'(M:NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
@ -614,8 +614,11 @@ write_query_answer( Bindings ) :-
'$call'(Y,CP,G0,M)
).
'$call'((X*->Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M).
(
'$call'(X,CP,G0,M)
*->
'$call'(Y,CP,G0,M)
).
'$call'((X->Y; Z),CP,G0,M) :- !,
(
'$call'(X,CP,G0,M)
@ -671,6 +674,13 @@ write_query_answer( Bindings ) :-
'$call'(X,CP,G0,M) ).
'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'(forall(X,Y), CP, _G0, _m) :- !,
\+ ('$call'(X, CP, G0, M),
\+ '$call'(Y, CP, G0, M) ).
'$call'(once(X), CP, G0, M) :- !,
( '$call'(X, CP, G0, M) -> true).
'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'([X|Y], _, _, M) :-
(Y == [] ->
consult(M:X)
@ -853,7 +863,6 @@ rules: first try term_expansion/2 in the current module, and then try to use th
for DCG rules is applied, together with the arithmetic optimizer
whenever the compilation of arithmetic expressions is in progress.
*/
expand_term(Term,Expanded) :-
(