diff --git a/console/yap.c b/console/yap.c index 9f5b41def..3bcda15ea 100755 --- a/console/yap.c +++ b/console/yap.c @@ -147,6 +147,7 @@ int main(int argc, char **argv) YAP_Reset(YAP_FULL_RESET, false); /* End preprocessor code */ + mtrace(); bool rc = exec_top_level(BootMode, &init_args); if (!rc) return 1; diff --git a/packages/real/yap4r/src/yap4r.cpp b/packages/real/yap4r/src/yap4r.cpp index b0ed348cb..ed9e36eb5 100644 --- a/packages/real/yap4r/src/yap4r.cpp +++ b/packages/real/yap4r/src/yap4r.cpp @@ -20,14 +20,19 @@ class yap4r { std::vector args; bool failed; + public: + + SEXP qsexp; yap4r(); - bool query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps); + bool query(std::string p_name, GenericVector sexps=R_NilValue, std::string p_module="user"); bool more(); bool done(); SEXP peek(int i); + bool compile(std::string s); + bool library(std::string s); }; - + yap4r::yap4r() { YAPEngineArgs *yargs = new YAPEngineArgs(); yap = new YAPEngine(yargs); @@ -36,25 +41,29 @@ public: - bool yap4r::query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps) { - +bool yap4r::query(std::string p_name, GenericVector sexps, std::string p_module) { if (q) { q->close(); q = nullptr; } - std::vector args = std::vector(); + yhandle_t t; + arity_t arity; + if (sexps.isNULL()) { + YAPTerm qt = YAPAtomTerm(p_name.c_str()); + q = new YAPQuery(qt); +t =qt.handle(); + } else { +arity = sexps.length(); + std::vector args = std::vector(); yhandle_t sls = Yap_NewHandles(sexps.length()); for (int i=0; imgoal(YAPApplTerm("compile",fs).term(), USER_MODULE); + +} +bool yap4r::library(std::string s) { + YAPTerm fs[1], l[1]; + l[0] = YAPAtomTerm(s.c_str()); + fs[0] = YAPApplTerm("library", l); + return yap->mgoal(YAPApplTerm("compile",fs).term(), USER_MODULE); + +} bool yap4r::more() { bool rc = true; @@ -96,6 +120,8 @@ public: SEXP yap4r::peek(int i) { if (failed || q==nullptr) return R_MissingArg; + if (i==0) + return qsexp; return term_to_sexp(Yap_InitSlot(Yap_XREGS[i]), false); } @@ -106,6 +132,8 @@ public: .method( "query", &yap4r::query, "create an active query within the engine") .method( "more", &yap4r::more, "ask for an extra solution") .method( "done", &yap4r::done, "terminate the query") + .method( "compile", &yap4r::compile, "compile the file") + .method( "library", &yap4r::library, "compile the library") .method( "peek", &yap4r::peek, "load arg[i] into R") ; } diff --git a/packages/yap-lbfgs/lbfgs.pl b/packages/yap-lbfgs/lbfgs.pl index 1d5e39452..a64a6abff 100644 --- a/packages/yap-lbfgs/lbfgs.pl +++ b/packages/yap-lbfgs/lbfgs.pl @@ -26,10 +26,9 @@ lbfgs_finalize/1, - lbfgs_set_parameter/3, - lbfgs_get_parameter/3, - lbfgs_parameters/0, - lbfgs_parameters/1]). + lbfgs_set_parameter/2, + lbfgs_get_parameter/2, + lbfgs_parameters/0]). % switch on all the checks to reduce bug searching time % :- yap_flag(unknown,error). @@ -187,12 +186,12 @@ lbfgs_finalize(t(_N,X,_U,Params)) :- run the algorithm. output the final score of the function being optimised */ -lbfgs_run(t(N,X,U,Params),FX) :- - lbfgs(N,X, Params, U, FX). +lbfgs_run(t(N,X,U),FX) :- + lbfgs(N,X, U, FX). -/** @pred lbfgs_parameters/1 +/** @pred lbfgs_parameters/0 Prints a table with the current parameters. See the documentation of libLBFGS for the meaning of each parameter. @@ -220,47 +219,43 @@ int orthantwise_end -1 End index for computing the L1 norm ~~~~ */ lbfgs_parameters :- - lbfgs_defaults(Params), - lbfgs_parameters(t(_X,_,_,Params)). - -lbfgs_parameters(t(_,_,_,Params)) :- - lbfgs_get_parameter(m,M ,Params), - lbfgs_get_parameter(epsilon,Epsilon ,Params), - lbfgs_get_parameter(past,Past ,Params), - lbfgs_get_parameter(delta,Delta ,Params), - lbfgs_get_parameter(max_iterations,Max_Iterations ,Params), - lbfgs_get_parameter(linesearch,Linesearch ,Params), - lbfgs_get_parameter(max_linesearch,Max_Linesearch ,Params), - lbfgs_get_parameter(min_step,Min_Step ,Params), - lbfgs_get_parameter(max_step,Max_Step ,Params), - lbfgs_get_parameter(ftol,Ftol ,Params), - lbfgs_get_parameter(gtol,Gtol ,Params), - lbfgs_get_parameter(xtol,Xtol ,Params), - lbfgs_get_parameter(orthantwise_c,Orthantwise_C ,Params), - lbfgs_get_parameter(orthantwise_start,Orthantwise_Start ,Params), - lbfgs_get_parameter(orthantwise_end,Orthantwise_End ,Params), + lbfgs_get_parameter(m,M ), + lbfgs_get_parameter(epsilon,Epsilon ), + lbfgs_get_parameter(past,Past ), + lbfgs_get_parameter(delta,Delta ), + lbfgs_get_parameter(max_iterations,Max_Iterations ), + lbfgs_get_parameter(linesearch,Linesearch ), + lbfgs_get_parameter(max_linesearch,Max_Linesearch ), + lbfgs_get_parameter(min_step,Min_Step ), + lbfgs_get_parameter(max_step,Max_Step ), + lbfgs_get_parameter(ftol,Ftol ), + lbfgs_get_parameter(gtol,Gtol ), + lbfgs_get_parameter(xtol,Xtol ), + lbfgs_get_parameter(orthantwise_c,Orthantwise_C ), + lbfgs_get_parameter(orthantwise_start,Orthantwise_Start ), + lbfgs_get_parameter(orthantwise_end,Orthantwise_End ), format('/******************************************************************************************~n',[] ), - print_param('Name','Value','Description','Type' ,Params), + print_param('Name','Value','Description','Type' ), format('******************************************************************************************~n',[] ), - print_param(m,M,'The number of corrections to approximate the inverse hessian matrix.',int ,Params), - print_param(epsilon,Epsilon,'Epsilon for convergence test.',float ,Params), - print_param(past,Past,'Distance for delta-based convergence test.',int ,Params), - print_param(delta,Delta,'Delta for convergence test.',float ,Params), - print_param(max_iterations,Max_Iterations,'The maximum number of iterations',int ,Params), - print_param(linesearch,Linesearch,'The line search algorithm.',int ,Params), - print_param(max_linesearch,Max_Linesearch,'The maximum number of trials for the line search.',int ,Params), - print_param(min_step,Min_Step,'The minimum step of the line search routine.',float ,Params), - print_param(max_step,Max_Step,'The maximum step of the line search.',float ,Params), - print_param(ftol,Ftol,'A parameter to control the accuracy of the line search routine.',float ,Params), - print_param(gtol,Gtol,'A parameter to control the accuracy of the line search routine.',float ,Params), - print_param(xtol,Xtol,'The machine precision for floating-point values.',float ,Params), - print_param(orthantwise_c,Orthantwise_C,'Coefficient for the L1 norm of variables',float ,Params), - print_param(orthantwise_start,Orthantwise_Start,'Start index for computing the L1 norm of the variables.',int ,Params), - print_param(orthantwise_end,Orthantwise_End,'End index for computing the L1 norm of the variables.',int ,Params), + print_param(m,M,'The number of corrections to approximate the inverse hessian matrix.',int ), + print_param(epsilon,Epsilon,'Epsilon for convergence test.',float ), + print_param(past,Past,'Distance for delta-based convergence test.',int ), + print_param(delta,Delta,'Delta for convergence test.',float ), + print_param(max_iterations,Max_Iterations,'The maximum number of iterations',int ), + print_param(linesearch,Linesearch,'The line search algorithm.',int ), + print_param(max_linesearch,Max_Linesearch,'The maximum number of trials for the line search.',int ), + print_param(min_step,Min_Step,'The minimum step of the line search routine.',float ), + print_param(max_step,Max_Step,'The maximum step of the line search.',float ), + print_param(ftol,Ftol,'A parameter to control the accuracy of the line search routine.',float ), + print_param(gtol,Gtol,'A parameter to control the accuracy of the line search routine.',float ), + print_param(xtol,Xtol,'The machine precision for floating-point values.',float ), + print_param(orthantwise_c,Orthantwise_C,'Coefficient for the L1 norm of variables',float ), + print_param(orthantwise_start,Orthantwise_Start,'Start index for computing the L1 norm of the variables.',int ), + 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,Solver) to change parameters~n',[]), - format(' use lbfgs_get_parameter(Name,Value,Solver) to see current parameters~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_parameters to print this overview~2n',[]). diff --git a/packages/yap-lbfgs/yap_lbfgs.c b/packages/yap-lbfgs/yap_lbfgs.c index a5db1344d..2b30610d5 100644 --- a/packages/yap-lbfgs/yap_lbfgs.c +++ b/packages/yap-lbfgs/yap_lbfgs.c @@ -39,14 +39,14 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x, YAP_Term call; YAP_Bool result; lbfgsfloatval_t rc; - YAP_Term v; + YAP_Term v, t1, t12; YAP_Term t[6], t2[2]; t[0] = v = YAP_MkVarTerm(); - t[1] = YAP_MkIntTerm((YAP_Int)x); - t[1] = YAP_MkApplTerm(ffloats, 1, t + 1); - t[2] = YAP_MkIntTerm((YAP_Int)g_tmp); - t[2] = YAP_MkApplTerm(ffloats, 1, t + 2); + t1 = YAP_MkIntTerm((YAP_Int)x); + t[1] = YAP_MkApplTerm(ffloats, 1, &t1); + t12 = YAP_MkIntTerm((YAP_Int)g_tmp); + t[2] = YAP_MkApplTerm(ffloats, 1, &t12); t[3] = YAP_MkIntTerm(n); t[4] = YAP_MkFloatTerm(step); t[5] = YAP_MkIntTerm((YAP_Int)instance); @@ -310,8 +310,10 @@ static YAP_Bool p_lbfgs(void) { s = "A logic error (negative line-search step) occurred."; break; } - fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s); - + char ss[1024]; + snprintf(ss, 1023, "optimization terminated with code %d: %s\n", ret, s); + fputs(ss, stderr); + return true; } @@ -326,16 +328,8 @@ static YAP_Bool lbfgs_grab(void) { return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t)); } -static YAP_Bool lbfgs_parameters(void) { - lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t)); - lbfgs_parameter_init(x); - return YAP_Unify(YAP_ARG1, YAP_MkIntTerm((YAP_Int)x)); -} +static lbfgs_parameter_t parms; -static YAP_Bool lbfgs_release_parameters(void) { - free((void *)YAP_IntOfTerm(YAP_ARG1)); - return true; -} static YAP_Bool lbfgs_release(void) { /* if (lbfgs_status == LBFGS_STATUS_NONE) { */ @@ -349,11 +343,11 @@ static YAP_Bool lbfgs_release(void) { return TRUE; /* return FALSE; */ } +static YAP_Bool lbfgs_defaults(void) { -static lbfgs_parameter_t *get_params(YAP_Term t) { - YAP_Int ar = YAP_ArityOfFunctor(YAP_FunctorOfTerm(t)); - YAP_Term arg = YAP_ArgOfTerm(ar, t); - return (lbfgs_parameter_t *)YAP_IntOfTerm(arg); + lbfgs_parameter_init(&parms); + return TRUE; + /* return FALSE; */ } /** @pred lbfgs_set_parameter(+Name,+Value,+Parameters) @@ -363,7 +357,7 @@ is not running. static YAP_Bool lbfgs_set_parameter(void) { YAP_Term t1 = YAP_ARG1; YAP_Term t2 = YAP_ARG2; - lbfgs_parameter_t *param = get_params(YAP_ARG3); + lbfgs_parameter_t *param = &parms; /* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status != * LBFGS_STATUS_INITIALIZED){ */ /* printf("ERROR: Lbfgs is running right now. Please wait till it is @@ -523,9 +517,9 @@ Get the current Value for Name static YAP_Bool lbfgs_get_parameter(void) { YAP_Term t1 = YAP_ARG1; YAP_Term t2 = YAP_ARG2; - lbfgs_parameter_t *param = get_params(YAP_ARG3); + lbfgs_parameter_t *param = &parms; - if (!YAP_IsAtomTerm(t1)) { + if (!YAP_IsAtomTerm(t1)) { return FALSE; } @@ -575,14 +569,14 @@ X_API void init_lbfgs_predicates(void) { tuser = YAP_MkAtomTerm(YAP_LookupAtom("user")); // Initialize the parameters for the L-BFGS optimization. - // lbfgs_parameter_init(¶m); + lbfgs_parameter_init(&parms); YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2); YAP_UserCPredicate("lbfgs", p_lbfgs, 5); YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1); - YAP_UserCPredicate("lbfgs_defaults", lbfgs_parameters, 1); - YAP_UserCPredicate("lbfgs_release_parameters", lbfgs_release_parameters, 1); - YAP_UserCPredicate("lbfgs_set_parameter", lbfgs_set_parameter, 3); - YAP_UserCPredicate("lbfgs_get_parameter", lbfgs_get_parameter, 3); + YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0); + + YAP_UserCPredicate("lbfgs_set_parameter", lbfgs_set_parameter, 2); + YAP_UserCPredicate("lbfgs_get_parameter", lbfgs_get_parameter, 2); }