static int
item2(YAP_Term tvar, YAP_Term titem, int offx, int offy)
{
mxArray *mat;
int rows;
int cols;
int off;
mat = get_array(tvar);
rows = mxGetM(mat);
cols = mxGetN(mat);
off = MAT_ACCESS(offx,offy,rows,cols);
if (!mat)
return FALSE;
if (mxIsInt32(mat)) {
INT32_T *input = (INT32_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsInt64(mat)) {
INT64_T *input = (INT64_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsCell(mat)) {
if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm((YAP_Int)mxGetCell(mat,off)));
} else {
mxArray *mat2 = get_array(titem);
mxSetCell(mat,off, mat2);
}
} else if (mxIsDouble(mat)) {
double *input = mxGetPr(mat);
if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else {
return YAP_Unify(titem, YAP_MkFloatTerm(input[off]));
}
} else
return FALSE;
return cp_back(tvar, mat);
}
/** @pred optimizer_set_g(+I,+G) Set the current value for `g[I]` (the
partial derivative of _F_ with respect to `x[I]`). Can only be called
from the evaluate call back predicate.
*/
static int set_g_value(void) {
YAP_Term t1=YAP_ARG1;
YAP_Term t2=YAP_ARG2;
int i=0;
if (optimizer_status != OPTIMIZER_STATUS_CB_EVAL) {
printf("ERROR: optimizer_set_g/2 can only be called by the evaluation call back function.\n");
return FALSE;
}
if (YAP_IsIntTerm(t1)) {
i=YAP_IntOfTerm(t1);
} else {
return FALSE;
}
if (i<0 || i>=n) {
return FALSE;
}
if (YAP_IsFloatTerm(t2)) {
g[i]=(lbfgsfloatval_t) YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
g[i]=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
return TRUE;
}
static mxArray*
get_array(YAP_Term ti)
{
if (YAP_IsIntTerm(ti)) {
return mxCreateDoubleScalar(YAP_IntOfTerm(ti));
} else if (YAP_IsFloatTerm(ti)) {
return mxCreateDoubleScalar(YAP_FloatOfTerm(ti));
} else if (YAP_IsAtomTerm(ti)) {
return matlab_getvar(ti);
} else if (YAP_IsPairTerm(ti)) {
YAP_Term tv = YAP_HeadOfTerm(ti);
YAP_Term tf = YAP_TailOfTerm(ti);
const mxArray *mout;
if (!YAP_IsAtomTerm(tv)) {
char s[BUFSIZE];
if (!YAP_StringToBuffer(ti, s, BUFSIZE))
return FALSE;
return mxCreateString(s);
}
mout = matlab_getvar(tv);
if (!mout)
return FALSE;
if (YAP_IsIntTerm(tf)) {
return mxGetFieldByNumber(mout, 0, YAP_IntOfTerm(tf));
} else if (YAP_IsAtomTerm(tf)) {
const char *s=YAP_AtomName(YAP_AtomOfTerm(tf));
return mxGetField(mout, 0, s);
} else {
return NULL;
}
} else {
return (mxArray *)YAP_IntOfTerm(YAP_ArgOfTerm(1,ti));
}
}
/** @pred optimizer_set_x(+I,+X)
Set the current value for `x[I]`. Only possible when the optimizer is
initialized but not running.
*/
static int set_x_value(void) {
YAP_Term t1=YAP_ARG1;
YAP_Term t2=YAP_ARG2;
int i=0;
if (optimizer_status!=OPTIMIZER_STATUS_INITIALIZED) {
printf("ERROR: set_x_value/2 can be called only when the optimizer is initialized and not running.\n");
return FALSE;
}
if (YAP_IsIntTerm(t1)) {
i=YAP_IntOfTerm(t1);
} else {
return FALSE;
}
if (i<0 || i>=n) {
printf("ERROR: invalid index for set_x_value/2.\n");
return FALSE;
}
if (YAP_IsFloatTerm(t2)) {
x[i]=(lbfgsfloatval_t) YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
x[i]=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
return TRUE;
}
static int
item1(YAP_Term tvar, YAP_Term titem, int off)
{
mxArray *mat;
mat = get_array(tvar);
if (!mat)
return FALSE;
if (mxIsInt32(mat)) {
INT32_T *input = (INT32_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsInt64(mat)) {
INT64_T *input = (INT64_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsCell(mat)) {
if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm((YAP_Int)mxGetCell(mat,off)));
} else {
mxArray *mat2 = get_array(titem);
mxSetCell(mat,off, mat2);
}
} else if (mxIsDouble(mat)) {
double *input = mxGetPr(mat);
if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else {
return YAP_Unify(titem, YAP_MkFloatTerm(input[off]));
}
} else
return FALSE;
return cp_back(tvar, mat);
}
static lbfgsfloatval_t evaluate(
void *instance,
const lbfgsfloatval_t *x,
lbfgsfloatval_t *g_tmp,
const int n,
const lbfgsfloatval_t step
)
{
YAP_Term call;
YAP_Term a1;
YAP_Bool result;
YAP_Int s1;
YAP_Term t[3];
t[0] = YAP_MkVarTerm();
t[1] = YAP_MkIntTerm(n);
t[2] = YAP_MkFloatTerm(step);
call = YAP_MkApplTerm(fcall3, 3, t);
g=g_tmp;
s1 = YAP_InitSlot(call);
optimizer_status=OPTIMIZER_STATUS_CB_EVAL;
result=YAP_CallProlog(call);
optimizer_status=OPTIMIZER_STATUS_RUNNING;
if (result==FALSE) {
printf("ERROR: Calling the evaluate call back function in YAP.\n");
// Goal did not succeed
return FALSE;
}
call = YAP_GetFromSlot( s1 );
a1 = YAP_ArgOfTerm(1,call);
if (YAP_IsFloatTerm(a1)) {
YAP_ShutdownGoal( TRUE );
return (lbfgsfloatval_t) YAP_FloatOfTerm(a1);
} else if (YAP_IsIntTerm(a1)) {
YAP_ShutdownGoal( TRUE );
return (lbfgsfloatval_t) YAP_IntOfTerm(a1);
}
YAP_ShutdownGoal( TRUE );
fprintf(stderr, "ERROR: The evaluate call back function did not return a number as first argument.\n");
return 0;
}
static int YAP_IsNumberTerm (Term term, YAP_Float *n)
{
if (YAP_IsIntTerm (term) != FALSE)
{
if (n != NULL)
*n = (YAP_Float) YAP_IntOfTerm (term);
return (TRUE);
}
if (YAP_IsFloatTerm (term) != FALSE)
{
if (n != NULL)
*n = YAP_FloatOfTerm (term);
return (TRUE);
}
return (FALSE);
}
static int
p_set_float_array(void)
{
int rows, cols, i = 0, j = 0;
double *input;
mxArray *mat;
YAP_Term tl = YAP_ARG3;
rows = YAP_IntOfTerm(YAP_ARG1);
cols = YAP_IntOfTerm(YAP_ARG2);
if (!(mat = mxCreateDoubleMatrix(rows, cols, mxREAL)))
return FALSE;
input = mxGetPr(mat);
/* copy ints to matrix. */
for (i = 0; i < rows; i++) {
for (j = 0; j < cols; j++) {
YAP_Term th;
if (!YAP_IsPairTerm(tl)) {
return FALSE;
}
th = YAP_HeadOfTerm(tl);
if (YAP_IsIntTerm(th)) {
input[MAT_ACCESS(i,j,rows,cols)] = YAP_IntOfTerm(th);
} else if (YAP_IsFloatTerm(th)) {
input[MAT_ACCESS(i,j,rows,cols)] = YAP_FloatOfTerm(th);
} else {
/* ERROR */
return FALSE;
}
tl = YAP_TailOfTerm(tl);
}
}
if (YAP_IsAtomTerm(YAP_ARG4)) {
return !engPutVariable(Meng, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG4)), mat);
}
return YAP_Unify(YAP_ARG4,address2term(mat));
}
static int
p_set_float_vector(void)
{
mwSize len[1];
int i = 0;
double *input;
mxArray *mat;
YAP_Term tl = YAP_ARG2;
len[0] = YAP_IntOfTerm(YAP_ARG1);
if (!(mat = mxCreateNumericArray(1,len, mxDOUBLE_CLASS, mxREAL)))
return FALSE;
input = mxGetPr(mat);
/* copy ints to matrix. */
for (i = 0; i < len[0]; i++) {
YAP_Term th;
if (!YAP_IsPairTerm(tl)) {
return FALSE;
}
th = YAP_HeadOfTerm(tl);
if (YAP_IsIntTerm(th)) {
input[i] = YAP_IntOfTerm(th);
} else if (YAP_IsFloatTerm(th)) {
input[i] = YAP_FloatOfTerm(th);
} else {
/* ERROR */
return FALSE;
}
tl = YAP_TailOfTerm(tl);
}
if (YAP_IsAtomTerm(YAP_ARG3)) {
return !engPutVariable(Meng, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), mat);
}
return YAP_Unify(YAP_ARG3,address2term(mat));
}
/** @pred optimizer_set_parameter(+Name,+Value)
Set the parameter Name to Value. Only possible while the optimizer
is not running.
*/
static int optimizer_set_parameter( void ) {
YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2;
if (optimizer_status != OPTIMIZER_STATUS_NONE && optimizer_status != OPTIMIZER_STATUS_INITIALIZED){
printf("ERROR: Optimizer is running right now. Please wait till it is finished.\n");
return FALSE;
}
if (! YAP_IsAtomTerm(t1)) {
return FALSE;
}
const char* name=YAP_AtomName(YAP_AtomOfTerm(t1));
if ((strcmp(name, "m") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.m = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "epsilon") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.epsilon=v;
} else if ((strcmp(name, "past") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.past = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "delta") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.delta=v;
} else if ((strcmp(name, "max_iterations") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.max_iterations = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "linesearch") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.linesearch = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "max_linesearch") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.max_linesearch = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "min_step") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.min_step=v;
} else if ((strcmp(name, "max_step") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.max_step=v;
} else if ((strcmp(name, "ftol") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.ftol=v;
} else if ((strcmp(name, "gtol") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.gtol=v;
} else if ((strcmp(name, "xtol") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.xtol=v;
} else if ((strcmp(name, "orthantwise_c") == 0)) {
lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
param.orthantwise_c=v;
} else if ((strcmp(name, "orthantwise_start") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.orthantwise_start = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "orthantwise_end") == 0)) {
if (! YAP_IsIntTerm(t2)) {
return FALSE;
}
param.orthantwise_end = YAP_IntOfTerm(t2);
} else {
printf("ERROR: The parameter %s is unknown.\n",name);
return FALSE;
}
return TRUE;
}