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; }