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

heap

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-04-04 13:27:06 +01:00
parent c04298c1d7
commit 13982dcc94
6 changed files with 49 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
C/globals.c
View File

@ -30,7 +30,7 @@ static char SccsId[] = "%W% %G%";
/**
@defgroup Global_Variables Global Variables
@defgroup Global_Variables Global Variables
@ingroup builtins
@{
@ -272,12 +272,7 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
} else {
XREGS[arity + 1] = arena;
/* try to recover some room */
if (arena == LOCAL_GlobalArena && 10 * (pt - H0) > 8 * (HR - H0)) {
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP));
arena = XREGS[arity + 1];
pt = ArenaLimit(arena);
if ((size = Yap_InsertInGlobal(pt, size * sizeof(CELL))) == 0) {
@ -1840,20 +1835,11 @@ static Term MkZeroApplTerm(Functor f, UInt sz USES_REGS) {
return tf;
}
/**
* @pred nb_heap(+_Size_,-_Heap_) is deterministic.
*
* Initialize a new binomial heap of size _Size_.
* The Heap resides in the Prolog stack, but the state of the
* Heap is not backtrable.
*
*/
static Int p_nb_heap(USES_REGS1) {
Term heap_arena, heap, *ar, *nar;
UInt hsize;
Term tsize = Deref(ARG1);
UInt arena_sz = (HR - H0) / 16;
UInt arena_sz = (ASP-HR) / 16;
if (IsVarTerm(tsize)) {
Yap_Error(INSTANTIATION_ERROR, tsize, "nb_heap");
@ -1865,7 +1851,8 @@ static Int p_nb_heap(USES_REGS1) {
}
hsize = IntegerOfTerm(tsize);
}
if (arena_sz < hsize)
arena_sz = hsize;
while ((heap = MkZeroApplTerm(
Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1),
2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) {
@ -1890,21 +1877,6 @@ static Int p_nb_heap(USES_REGS1) {
return TRUE;
}
/**
* @pred nb_heap_reset(+_Heap_) is deterministic.
*
* Set the number if entries in the heap to 0. Allows reusing
* the same space for several heaps.
*/
static Int p_nb_heap_reset(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "reset_heap");
if (!qd)
return FALSE;
qd[HEAP_SIZE] = MkIntTerm(0);
return true;
}
static Int p_nb_heap_close(USES_REGS1) {
Term t = Deref(ARG1);
if (!IsVarTerm(t)) {
@ -2078,7 +2050,6 @@ static Int p_nb_heap_del(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "deheap");
UInt old_sz, qsz;
Term arena;
CELL *oldH, *oldHB;
Term tk, tv;
if (!qd)
@ -2091,10 +2062,7 @@ static Int p_nb_heap_del(USES_REGS1) {
return FALSE;
old_sz = ArenaSz(arena);
/* garbage collection ? */
oldH = HR;
oldHB = HB;
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
qd[HEAP_SIZE] =MkIntTerm(qsz - 1);
tk = qd[HEAP_START];
tv = qd[HEAP_START + 1];
DelHeapRoot(qd + HEAP_START, qsz);
@ -2820,7 +2788,6 @@ void Yap_InitGlobals(void) {
Yap_InitCPred("nb_heap_peek", 3, p_nb_heap_peek, SafePredFlag);
Yap_InitCPred("nb_heap_empty", 1, p_nb_heap_empty, SafePredFlag);
Yap_InitCPred("nb_heap_size", 2, p_nb_heap_size, SafePredFlag);
Yap_InitCPred("nb_heap_reset", 1, p_nb_heap_reset, SafePredFlag);
Yap_InitCPred("nb_beam", 2, p_nb_beam, 0L);
Yap_InitCPred("nb_beam_close", 1, p_nb_beam_close, SafePredFlag);
Yap_InitCPred("nb_beam_add", 3, p_nb_beam_add_to_beam, 0L);

3
C/write.c
View File

@ -1059,6 +1059,9 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc('}', wglb->stream);
lastw = separator;
} else {
if (!wglb->Ignore_ops && atom == AtomHeap) {
Arity = 3+2*IntegerOfTerm(ArgOfTerm(1,t));
}
putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator;
wropen_bracket(wglb, FALSE);

4
packages/ProbLog/problog_examples/kbgraph.yap
View File

@ -28,7 +28,6 @@ graph2bdd(Query,1,bdd(D,T,Vs)) :-
:- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))).
:- nb_heap(100000,Q), nb_setval(heap,Q).
%:- leash(0), spy graph2bdd.
@ -59,8 +58,7 @@ graph(X,Y,Trie_Completed_Proofs,Vs) :-
!,
export_answer([Y|Final], Trie_Completed_Proofs,Vs).
graph(X,Y,Trie_Completed_Proofs, Vs) :-
nb_getval(heap, Q),
nb_heap_reset(Q),
nb_heap(100000,Q),
path(X,Y,X,[X],Final, 0, _Pr, Q),
!,
export_answer(Final, Trie_Completed_Proofs, Vs).

37
packages/ProbLog/problog_lbfgs.yap
View File

@ -263,8 +263,6 @@ user:test_example(A,B,C,=) :-
user:test_example(A,B,C),
\+ user:problog_discard_example(B).
solver_iterations(0,0).
%========================================================================
%= store the facts with the learned probabilities to a file
%========================================================================
@ -565,19 +563,10 @@ init_one_query(QueryID,Query,_Type) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))),
problog_flag(init_method,(Query,1,Bdd,user:graph2bdd(Query,1,Bdd))),
!,
b_setval(problog_required_keep_ground_ids,false),
Bdd = bdd(Dir, Tree0,MapList),
user:graph2bdd(Query,N,Bdd),
reverse(Tree0,Tree),
%rb_new(H0),
%maplist_to_hash(MapList, H0, Hash),
%tree_to_grad(Tree, Hash, [], Grad),
% ;
% Bdd = bdd(-1,[],[]),
% Grad=[]
store_bdd(QueryID, Dir, Tree, MapList).
add_bdd(QueryID, Query, Bdd).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@ -592,6 +581,19 @@ init_one_query(QueryID,Query,_Type) :-
reverse(Tree0,Tree),
store_bdd(QueryID, Dir, Tree, MapList).
add_bdd(QueryID,Query, Bdd) :-
Bdd = bdd(Dir, Tree0,MapList),
user:graph2bdd(Query,1,Bdd),
!,
reverse(Tree0,Tree),
%rb_new(H0),
%maplist_to_hash(MapList, H0, Hash),
%tree_to_grad(Tree, Hash, [], Grad),
% ;
% Bdd = bdd(-1,[],[]),
% Grad=[]
store_bdd(QueryID, Dir, Tree, MapList).
init_one_query(_,_,_).
store_bdd(QueryID, Dir, Tree, MapList) :-
(QueryID mod 100 =:= 0 ->writeln(QueryID) ; true),
@ -788,12 +790,7 @@ gradient_descent :-
% current_iteration(Iteration),
findall(FactID,tunable_fact(FactID,_GroundTruth),L),
length(L,N),
lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,_GroundTruth),
set_fact( FactID, Slope, X)
),
lbfgs_run(Solver,_BestF),
lbfgs_finalize(Solver),
lbfgs_run(N,X,_BestF),
mse_trainingset,
mse_testset.
@ -862,7 +859,7 @@ go( X,Grad, LLs) :-
compute_gradient( Grad, X, Slope, LL) :-
user:example(QueryID,_Query,QueryProb),
user:example(QueryID,_Query,QueryProb,_),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),

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

@ -20,9 +20,9 @@
:- module(lbfgs,[lbfgs_initialize/3,
:- module(lbfgs,[lbfgs_initialize/2,
lbfgs_initialize/4,
lbfgs_run/2,
lbfgs_run/3,
lbfgs_finalize/1,
@ -153,7 +153,6 @@ yes
:- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates').
/** @pred lbfgs_initialize(+N, -SolverInfo)
Do initial memory allocation and a reference to a descriptor.
@ -161,11 +160,7 @@ Do initial memory allocation and a reference to a descriptor.
lbfgs_initialize(1, Block)
~~~~~
*/
lbfgs_initialize(N,X,t(N,X,U,Params)) :-
lbfgs_initialize(N,X,0,t(N,X,U,Params)).
lbfgs_initialize(N,X,U,t(N,X,U,Params)) :-
lbfgs_defaults(Params),
lbfgs_initialize(N,X) :-
integer(N),
N>0,
lbfgs_grab(N,X).
@ -178,16 +173,14 @@ lbfgs_initialize(N,X,U,t(N,X,U,Params)) :-
Clean up the memory.
*/
lbfgs_finalize(t(_N,X,_U,Params)) :-
lbfgs_release(X) ,
lbfgs_release_parameters(Params) .
lbfgs_finalize(_N).
/** @pred lbfgs_run(+State, -FinalOutput)
run the algorithm. output the final score of the function being optimised
*/
lbfgs_run(t(N,X,U),FX) :-
lbfgs(N,X, U, FX).
lbfgs_run(N,X,FX) :-
lbfgs(N,X, FX).
@ -255,7 +248,7 @@ lbfgs_parameters :-
print_param(orthantwise_end,Orthantwise_End,'End index for computing the L1 norm of the variables.',int ),
format('******************************************************************************************/~n',[]),
format(' use lbfgs_set_parameter(Name,Value) to change parameters~n',[]),
format(' use lbfgs_get_parameter(Name,Value) to see current parameters~n',[]),
format(' use lbfgs_get_parameter(Name,Values) to see current parameters~n',[]),
format(' use lbfgs_parameters to print this overview~2n',[]).

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

@ -28,11 +28,15 @@
#define LBFGS_STATUS_CB_EVAL 3
#define LBFGS_STATUS_CB_PROGRESS 4
static lbfgs_parameter_t parms;
X_API void init_lbfgs_predicates(void);
YAP_Functor fevaluate, fprogress, fmodule, ffloats;
YAP_Term tuser;
lbfgsfloatval_t *x_p;
static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
lbfgsfloatval_t *g_tmp, const int n,
const lbfgsfloatval_t step) {
@ -193,127 +197,22 @@ static YAP_Bool p_lbfgs(void) {
if (n < 1) {
return FALSE;
}
sl = YAP_InitSlot(YAP_ARG6);
sl = YAP_InitSlot(YAP_ARG3);
x = (lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, YAP_ARG2));
lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3);
void *ui = (void *)YAP_IntOfTerm(YAP_ARG4);
if (!x_p)
x_p = lbfgs_malloc(n+1);
x = x_p;
t = YAP_MkIntTerm((YAP_Int)x);
YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t));
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)
return true;
const char *s;
switch (ret) {
case LBFGS_CONVERGENCE:
case LBFGS_STOP:
return true;
/** The initial variables already minimize the objective function. */
case LBFGS_ALREADY_MINIMIZED:
s = "The initial variables already minimize the objective function.";
break;
case LBFGSERR_UNKNOWNERROR:
s = "Unknownerror";
break;
case LBFGSERR_LOGICERROR:
s = "logic error.";
break;
case LBFGSERR_OUTOFMEMORY:
s = "out of memory";
break;
case LBFGSERR_CANCELED:
s = "canceled.";
break;
case LBFGSERR_INVALID_N:
s = "Invalid number of variables specified.";
break;
case LBFGSERR_INVALID_N_SSE:
s = "Invalid number of variables (for SSE) specified.";
break;
case LBFGSERR_INVALID_X_SSE:
s = "The array x must be aligned to 16 (for SSE).";
break;
case LBFGSERR_INVALID_EPSILON:
s = "Invalid parameter lbfgs_parameter_t::epsilon specified.";
break;
case LBFGSERR_INVALID_TESTPERIOD:
s = "Invalid parameter lbfgs_parameter_t::past specified.";
break;
case LBFGSERR_INVALID_DELTA:
s = "Invalid parameter lbfgs_parameter_t::delta specified.";
break;
case LBFGSERR_INVALID_LINESEARCH:
s = "Invalid parameter lbfgs_parameter_t::linesearch specified.";
break;
case LBFGSERR_INVALID_MINSTEP:
s = "Invalid parameter lbfgs_parameter_t::max_step specified.";
break;
case LBFGSERR_INVALID_MAXSTEP:
s = "Invalid parameter lbfgs_parameter_t::max_step specified.";
break;
case LBFGSERR_INVALID_FTOL:
s = "Invalid parameter lbfgs_parameter_t::ftol specified.";
break;
case LBFGSERR_INVALID_WOLFE:
s = "Invalid parameter lbfgs_parameter_t::wolfe specified.";
break;
case LBFGSERR_INVALID_GTOL:
s = "Invalid parameter lbfgs_parameter_t::gtol specified.";
break;
case LBFGSERR_INVALID_XTOL:
s = "Invalid parameter lbfgs_parameter_t::xtol specified.";
break;
case LBFGSERR_INVALID_MAXLINESEARCH:
s = "Invalid parameter lbfgs_parameter_t::max_linesearch specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_c specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE_START:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_start specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE_END:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_end specified.";
break;
case LBFGSERR_OUTOFINTERVAL:
s = "The line-search step went out of the interval of uncertainty.";
break;
case LBFGSERR_INCORRECT_TMINMAX:
s = "A logic error occurred; alternatively, the interval of uncertaity "
"became too small.";
break;
case LBFGSERR_ROUNDING_ERROR:
s = "A rounding error occurred; alternatively, no line-search s";
break;
case LBFGSERR_MINIMUMSTEP:
s = "The line-search step became smaller than lbfgs_parameter_t::min_step.";
break;
case LBFGSERR_MAXIMUMSTEP:
s = "The line-search step became larger than lbfgs_parameter_t::max_step.";
break;
case LBFGSERR_MAXIMUMLINESEARCH:
s = "The line-search routine reaches the maximum number of evaluations.";
break;
case LBFGSERR_MAXIMUMITERATION:
s = "The algorithm routine reaches the maximum number of iterations "
"lbfgs_parameter_t::xtol.";
break;
case LBFGSERR_WIDTHTOOSMALL:
s = "Relative width of the interval of uncertainty is at m";
break;
case LBFGSERR_INVALIDPARAMETERS:
s = "A logic error (negative line-search step) occurred.";
break;
}
char ss[1024];
snprintf(ss, 1023, "optimization terminated with code %d: %s\n", ret, s);
fputs(ss, stderr);
fprintf(stderr, "optimization terminated with code %d\n ",ret);
return true;
}
@ -328,8 +227,6 @@ static YAP_Bool lbfgs_grab(void) {
return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t));
}
static lbfgs_parameter_t parms;
static YAP_Bool lbfgs_release(void) {
/* if (lbfgs_status == LBFGS_STATUS_NONE) { */
@ -572,7 +469,7 @@ X_API void init_lbfgs_predicates(void) {
lbfgs_parameter_init(&parms);
YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 5);
YAP_UserCPredicate("lbfgs", p_lbfgs, 3);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0);