This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/yap-lbfgs/yap_lbfgs.c

589 lines
17 KiB
C
Raw Normal View History

2013-06-13 23:57:55 +01:00
#include "YapInterface.h"
#include <lbfgs.h>
#include <stdio.h>
2018-10-07 14:27:01 +01:00
#include <string.h>
2013-06-13 23:57:55 +01:00
/*
This file is part of YAP-LBFGS.
Copyright (C) 2009 Bernd Gutmann
YAP-LBFGS is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
YAP-LBFGS is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with YAP-LBFGS. If not, see <http://www.gnu.org/licenses/>.
*/
// These constants describe the internal state
2018-10-07 14:27:01 +01:00
#define LBFGS_STATUS_NONE 0
2018-10-05 10:26:34 +01:00
#define LBFGS_STATUS_INITIALIZED 1
2018-10-07 14:27:01 +01:00
#define LBFGS_STATUS_RUNNING 2
#define LBFGS_STATUS_CB_EVAL 3
2018-10-05 10:26:34 +01:00
#define LBFGS_STATUS_CB_PROGRESS 4
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
X_API void init_lbfgs_predicates(void);
2013-06-13 23:57:55 +01:00
2018-09-13 13:35:37 +01:00
YAP_Functor fevaluate, fprogress, fmodule, ffloats;
YAP_Term tuser;
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
lbfgsfloatval_t *g_tmp, const int n,
const lbfgsfloatval_t step) {
2013-06-13 23:57:55 +01:00
YAP_Term call;
YAP_Bool result;
2018-10-07 14:27:01 +01:00
lbfgsfloatval_t rc;
YAP_Term v;
2018-10-05 10:26:34 +01:00
YAP_Term t[6], t2[2];
2018-09-13 13:35:37 +01:00
2018-10-07 14:27:01 +01:00
t[0] = v = YAP_MkVarTerm();
2018-09-13 13:35:37 +01:00
t[1] = YAP_MkIntTerm((YAP_Int)x);
2018-10-07 14:27:01 +01:00
t[1] = YAP_MkApplTerm(ffloats, 1, t + 1);
2018-09-13 13:35:37 +01:00
t[2] = YAP_MkIntTerm((YAP_Int)g_tmp);
2018-10-07 14:27:01 +01:00
t[2] = YAP_MkApplTerm(ffloats, 1, t + 2);
2018-09-13 13:35:37 +01:00
t[3] = YAP_MkIntTerm(n);
t[4] = YAP_MkFloatTerm(step);
2018-10-05 10:26:34 +01:00
t[5] = YAP_MkIntTerm((YAP_Int)instance);
2013-06-13 23:57:55 +01:00
2018-09-13 13:35:37 +01:00
t2[0] = tuser;
2018-10-07 14:27:01 +01:00
t2[1] = YAP_MkApplTerm(fevaluate, 6, t);
2017-04-13 21:42:34 +01:00
2018-10-07 14:27:01 +01:00
call = YAP_MkApplTerm(fmodule, 2, t2);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
int sl = YAP_InitSlot(v);
// lbfgs_status=LBFGS_STATUS_CB_EVAL;
result = YAP_RunGoalOnce(call);
// lbfgs_status=LBFGS_STATUS_RUNNING;
2018-09-13 13:35:37 +01:00
2018-10-07 14:27:01 +01:00
if (result == FALSE) {
2014-12-14 12:05:43 +00:00
printf("ERROR: the evaluate call failed in YAP.\n");
2013-06-13 23:57:55 +01:00
// Goal did not succeed
2018-10-07 14:27:01 +01:00
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-10-09 13:47:27 +01:00
YAP_Term o;
if (YAP_IsIntTerm((o = YAP_GetFromSlot(sl))))
2018-11-04 10:55:58 +00:00
rc = YAP_IntOfTerm(o);
2018-10-09 13:47:27 +01:00
else
2018-11-04 10:55:58 +00:00
rc = YAP_FloatOfTerm(o);
2018-10-07 14:27:01 +01:00
YAP_RecoverSlots(1, sl);
2018-09-13 13:35:37 +01:00
return rc;
2013-06-13 23:57:55 +01:00
}
2018-10-07 14:27:01 +01:00
static int progress(void *instance, const lbfgsfloatval_t *local_x,
const lbfgsfloatval_t *local_g,
const lbfgsfloatval_t fx, const lbfgsfloatval_t xnorm,
const lbfgsfloatval_t gnorm, const lbfgsfloatval_t step,
int n, int k, int ls) {
2013-06-13 23:57:55 +01:00
YAP_Term call;
YAP_Bool result;
2013-10-08 13:05:08 +01:00
YAP_Int s1;
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
YAP_Term t[10], t2[2], v;
2013-06-20 03:36:18 +01:00
t[0] = YAP_MkFloatTerm(fx);
2018-09-13 13:35:37 +01:00
t[1] = YAP_MkIntTerm((YAP_Int)local_x);
2018-10-07 14:27:01 +01:00
t[1] = YAP_MkApplTerm(ffloats, 1, t + 1);
2018-09-13 13:35:37 +01:00
t[2] = YAP_MkIntTerm((YAP_Int)local_g);
2018-10-07 14:27:01 +01:00
t[2] = YAP_MkApplTerm(ffloats, 1, t + 2);
2018-09-13 13:35:37 +01:00
t[3] = YAP_MkFloatTerm(xnorm);
t[4] = YAP_MkFloatTerm(gnorm);
t[5] = YAP_MkFloatTerm(step);
t[6] = YAP_MkIntTerm(n);
t[7] = YAP_MkIntTerm(k);
t[8] = YAP_MkIntTerm(ls);
t[9] = v = YAP_MkVarTerm();
t2[0] = tuser;
2018-10-07 14:27:01 +01:00
t2[1] = YAP_MkApplTerm(fprogress, 10, t);
2018-09-13 13:35:37 +01:00
2018-10-07 14:27:01 +01:00
call = YAP_MkApplTerm(fmodule, 2, t2);
2018-09-13 13:35:37 +01:00
s1 = YAP_InitSlot(v);
2018-10-07 14:27:01 +01:00
// lbfgs_status=LBFGS_STATUS_CB_PROGRESS;
result = YAP_RunGoalOnce(call);
// lbfgs_status=LBFGS_STATUS_RUNNING;
2018-09-13 13:35:37 +01:00
2018-10-07 14:27:01 +01:00
YAP_Term o = YAP_GetFromSlot(s1);
2013-10-08 13:05:08 +01:00
2018-10-07 14:27:01 +01:00
if (result == FALSE) {
2018-10-05 10:26:34 +01:00
printf("ERROR: the progress call failed in YAP.\n");
2013-06-13 23:57:55 +01:00
// Goal did not succeed
2018-10-07 14:27:01 +01:00
return -1;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
if (YAP_IsIntTerm(o)) {
int v = YAP_IntOfTerm(o);
2018-10-07 14:27:01 +01:00
return (int)v;
2013-06-13 23:57:55 +01:00
}
2013-06-20 03:36:18 +01:00
2018-10-07 14:27:01 +01:00
fprintf(stderr, "ERROR: The progress call back function did not return an "
"integer as last argument\n");
2013-06-13 23:57:55 +01:00
return 1;
}
2018-10-05 10:26:34 +01:00
/** @pred lbfgs_initialize(+N,+Module,+Evaluate,+Progress)
2014-09-15 09:13:50 +01:00
Create space to optimize a function with _N_ variables (_N_ has to be
2017-04-13 21:42:34 +01:00
integer).
2014-09-15 09:13:50 +01:00
+ _Module</span>_ is the name of the module where the call back
2017-04-13 21:42:34 +01:00
predicates can be found,
2014-09-15 09:13:50 +01:00
+ _Evaluate_ is the call back predicate (arity 3)
2017-04-13 21:42:34 +01:00
to evaluate the function math <span class="math">_F</span>_,
2014-09-15 09:13:50 +01:00
+ _Progress_ is the call back predicate invoked
(arity 8) after every iteration
2017-04-13 21:42:34 +01:00
Example
2014-09-15 09:13:50 +01:00
~~~~
2018-10-05 10:26:34 +01:00
lbfgs_initialize(1,user,evaluate,progress,e,g)</span>
2014-09-15 09:13:50 +01:00
~~~~
The evaluate call back predicate has to be of the type
`evaluate(-F,+N,+Step)`. It has to calculate the current function
value _F_. _N_ is the
size of the parameter vector (the value which was used to initialize
LBFGS) and _Step_ is the current state of the
line search. The call back predicate can access the current values of
2018-10-05 10:26:34 +01:00
`x[i]` by calling `lbfgs_get_x(+I,-Xi)`. Finally, the call back
2014-09-15 09:13:50 +01:00
predicate has to calculate the gradient of _F</span>_
2018-10-05 10:26:34 +01:00
and set its value by calling `lbfgs_set_g(+I,+Gi)` for every `1<=I<=N`.
2014-09-15 09:13:50 +01:00
The progress call back predicate has to be of the type
`progress(+F,+X_Norm,+G_Norm,+Step,+N,+Iteration,+LS,-Continue)`. It
is called after every iteration. The call back predicate can access
the current values of _X_ and of the gradient by calling
2018-10-05 10:26:34 +01:00
`lbfgs_get_x(+I,-Xi)` and `lbfgs_get_g`(+I,-Gi)`
2014-09-15 09:13:50 +01:00
respectively. However, it must not call the setter predicates for <span
2018-10-05 10:26:34 +01:00
class="code"_X_ or _G_. If it tries to do so, the lbfgs will
2014-09-15 09:13:50 +01:00
terminate with an error. If _Continue_ is set to 0 (int) the
optimization process will continue for one more iteration, any other
value will terminate the optimization process.
*/
2018-10-05 10:26:34 +01:00
/**
* @pred lbfgs( N, X, U, FX )
*
* @Arg1 N: number of variables in problem
* @Arg[X0]: input vector
* @Arg[FX]: function value,
* @Arg[FX]: parameter
* @Arg[X0]: user data
* @Arg[FX]: status
*/
2018-10-07 14:27:01 +01:00
static YAP_Bool p_lbfgs(void) {
YAP_Term t1 = YAP_ARG1, t;
int n, sl;
2018-10-05 10:26:34 +01:00
lbfgsfloatval_t *x;
lbfgsfloatval_t fx;
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
if (!YAP_IsIntTerm(t1)) {
2018-08-21 03:01:03 +01:00
return false;
2013-06-13 23:57:55 +01:00
}
2018-10-07 14:27:01 +01:00
n = YAP_IntOfTerm(t1);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
if (n < 1) {
2013-06-13 23:57:55 +01:00
return FALSE;
}
2018-10-07 14:27:01 +01:00
sl = YAP_InitSlot(YAP_ARG6);
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);
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;
2018-10-05 10:26:34 +01:00
/** The initial variables already minimize the objective function. */
2018-10-07 14:27:01 +01:00
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:
2018-10-05 10:26:34 +01:00
s = "The line-search step became larger than lbfgs_parameter_t::max_step.";
2018-10-07 14:27:01 +01:00
break;
case LBFGSERR_MAXIMUMLINESEARCH:
2018-10-05 10:26:34 +01:00
s = "The line-search routine reaches the maximum number of evaluations.";
break;
2018-10-07 14:27:01 +01:00
case LBFGSERR_MAXIMUMITERATION:
s = "The algorithm routine reaches the maximum number of iterations "
"lbfgs_parameter_t::xtol.";
break;
case LBFGSERR_WIDTHTOOSMALL:
2018-10-05 10:26:34 +01:00
s = "Relative width of the interval of uncertainty is at m";
break;
2018-10-07 14:27:01 +01:00
case LBFGSERR_INVALIDPARAMETERS:
2018-10-05 10:26:34 +01:00
s = "A logic error (negative line-search step) occurred.";
break;
2018-10-07 14:27:01 +01:00
}
fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s);
2018-10-05 10:26:34 +01:00
2018-10-07 14:27:01 +01:00
return true;
2018-10-05 10:26:34 +01:00
}
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
static YAP_Bool lbfgs_grab(void) {
int n = YAP_IntOfTerm(YAP_ARG1);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
if (n < 1) {
2018-10-05 10:26:34 +01:00
return FALSE;
}
2018-10-07 14:27:01 +01:00
lbfgsfloatval_t *x = lbfgs_malloc(n);
2018-10-05 10:26:34 +01:00
YAP_Term t = YAP_MkIntTerm((YAP_Int)x);
2018-10-07 14:27:01 +01:00
return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t));
}
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
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));
}
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
static YAP_Bool lbfgs_release_parameters(void) {
free((void *)YAP_IntOfTerm(YAP_ARG1));
return true;
}
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
static YAP_Bool lbfgs_release(void) {
2018-10-05 10:26:34 +01:00
/* if (lbfgs_status == LBFGS_STATUS_NONE) { */
/* printf("Error: Lbfgs is not initialized.\n"); */
/* return FALSE; */
2018-09-13 13:35:37 +01:00
/* } */
2013-06-13 23:57:55 +01:00
2018-10-05 10:26:34 +01:00
/* if (lbfgs_status == LBFGS_STATUS_INITIALIZED) { */
2018-10-07 14:27:01 +01:00
lbfgs_free((lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, (YAP_ARG1))));
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
return TRUE;
/* return FALSE; */
}
2013-06-13 23:57:55 +01:00
2018-11-04 10:55:58 +00:00
static lbfgs_parameter_t *get_params(YAP_Term t) {
2018-10-10 12:33:05 +01:00
YAP_Int ar = YAP_ArityOfFunctor(YAP_FunctorOfTerm(t));
YAP_Term arg = YAP_ArgOfTerm(ar, t);
return (lbfgs_parameter_t *)YAP_IntOfTerm(arg);
}
2018-10-05 10:26:34 +01:00
/** @pred lbfgs_set_parameter(+Name,+Value,+Parameters)
Set the parameter Name to Value. Only possible while the lbfgs
2014-09-15 09:13:50 +01:00
is not running.
*/
2018-10-07 14:27:01 +01:00
static YAP_Bool lbfgs_set_parameter(void) {
2013-06-13 23:57:55 +01:00
YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2;
2018-10-10 12:33:05 +01:00
lbfgs_parameter_t *param = get_params(YAP_ARG3);
2018-10-07 14:27:01 +01:00
/* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status !=
* LBFGS_STATUS_INITIALIZED){ */
/* printf("ERROR: Lbfgs is running right now. Please wait till it is
* finished.\n"); */
2018-09-13 13:35:37 +01:00
/* return FALSE; */
/* } */
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
if (!YAP_IsAtomTerm(t1)) {
2013-06-13 23:57:55 +01:00
return FALSE;
}
2018-10-07 14:27:01 +01:00
const char *name = YAP_AtomName(YAP_AtomOfTerm(t1));
2013-06-13 23:57:55 +01:00
if ((strcmp(name, "m") == 0)) {
2018-10-07 14:27:01 +01:00
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->m = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "epsilon") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->epsilon = v;
} else if ((strcmp(name, "past") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->past = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "delta") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->delta = v;
} else if ((strcmp(name, "max_iterations") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->max_iterations = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "linesearch") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->linesearch = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "max_linesearch") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->max_linesearch = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "min_step") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->min_step = v;
} else if ((strcmp(name, "max_step") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->max_step = v;
} else if ((strcmp(name, "ftol") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->ftol = v;
} else if ((strcmp(name, "gtol") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->gtol = v;
} else if ((strcmp(name, "xtol") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->xtol = v;
} else if ((strcmp(name, "orthantwise_c") == 0)) {
2013-06-13 23:57:55 +01:00
lbfgsfloatval_t v;
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
if (YAP_IsFloatTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = YAP_FloatOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else if (YAP_IsIntTerm(t2)) {
2018-10-07 14:27:01 +01:00
v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
return FALSE;
}
2018-10-07 14:27:01 +01:00
param->orthantwise_c = v;
} else if ((strcmp(name, "orthantwise_start") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->orthantwise_start = YAP_IntOfTerm(t2);
2018-10-07 14:27:01 +01:00
} else if ((strcmp(name, "orthantwise_end") == 0)) {
if (!YAP_IsIntTerm(t2)) {
return FALSE;
2013-06-13 23:57:55 +01:00
}
2018-09-13 13:35:37 +01:00
param->orthantwise_end = YAP_IntOfTerm(t2);
2013-06-13 23:57:55 +01:00
} else {
2018-10-07 14:27:01 +01:00
printf("ERROR: The parameter %s is unknown.\n", name);
return FALSE;
2013-06-13 23:57:55 +01:00
}
2017-04-13 21:42:34 +01:00
2013-06-13 23:57:55 +01:00
return TRUE;
}
2018-10-05 10:26:34 +01:00
/** @pred lbfgs_get_parameter(+Name,-Value)</h3>
2014-09-15 09:13:50 +01:00
Get the current Value for Name
*/
2018-10-07 14:27:01 +01:00
static YAP_Bool lbfgs_get_parameter(void) {
2013-06-13 23:57:55 +01:00
YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2;
2018-10-10 12:33:05 +01:00
lbfgs_parameter_t *param = get_params(YAP_ARG3);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
if (!YAP_IsAtomTerm(t1)) {
2013-06-13 23:57:55 +01:00
return FALSE;
}
2018-10-07 14:27:01 +01:00
const char *name = YAP_AtomName(YAP_AtomOfTerm(t1));
2013-06-13 23:57:55 +01:00
if ((strcmp(name, "m") == 0)) {
2018-10-07 14:27:01 +01:00
return YAP_Unify(t2, YAP_MkIntTerm(param->m));
} else if ((strcmp(name, "epsilon") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->epsilon));
} else if ((strcmp(name, "past") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->past));
} else if ((strcmp(name, "delta") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->delta));
} else if ((strcmp(name, "max_iterations") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->max_iterations));
} else if ((strcmp(name, "linesearch") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->linesearch));
} else if ((strcmp(name, "max_linesearch") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->max_linesearch));
} else if ((strcmp(name, "min_step") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->min_step));
} else if ((strcmp(name, "max_step") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->max_step));
} else if ((strcmp(name, "ftol") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->ftol));
} else if ((strcmp(name, "gtol") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->gtol));
} else if ((strcmp(name, "xtol") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->xtol));
} else if ((strcmp(name, "orthantwise_c") == 0)) {
return YAP_Unify(t2, YAP_MkFloatTerm(param->orthantwise_c));
} else if ((strcmp(name, "orthantwise_start") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_start));
} else if ((strcmp(name, "orthantwise_end") == 0)) {
return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_end));
2013-06-13 23:57:55 +01:00
}
2018-10-07 14:27:01 +01:00
printf("ERROR: The parameter %s is unknown.\n", name);
2018-08-21 03:01:03 +01:00
return false;
2013-06-13 23:57:55 +01:00
}
2018-10-07 14:27:01 +01:00
X_API void init_lbfgs_predicates(void) {
2018-10-05 10:26:34 +01:00
fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6);
2018-09-13 13:35:37 +01:00
fprogress = YAP_MkFunctor(YAP_LookupAtom("progress"), 10);
fmodule = YAP_MkFunctor(YAP_LookupAtom(":"), 2);
ffloats = YAP_MkFunctor(YAP_LookupAtom("floats"), 1);
tuser = YAP_MkAtomTerm(YAP_LookupAtom("user"));
2013-06-20 03:36:18 +01:00
2018-10-07 14:27:01 +01:00
// Initialize the parameters for the L-BFGS optimization.
2018-09-13 13:35:37 +01:00
// lbfgs_parameter_init(&param);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 5);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
2013-06-13 23:57:55 +01:00
2018-10-07 14:27:01 +01:00
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);
2017-04-13 21:42:34 +01:00
}