[Deoptim-commits] r106 - pkg/DEoptim/src

[noreply at r-forge.r-project.org]

Author: bodanker
Date: 2012-07-01 15:40:30 +0200 (Sun, 01 Jul 2012)
New Revision: 106

Modified:
   pkg/DEoptim/src/evaluate.c
Log:
- Fix popEvaluate when objective function returns integer


Modified: pkg/DEoptim/src/evaluate.c
===================================================================
--- pkg/DEoptim/src/evaluate.c	2012-06-16 01:27:23 UTC (rev 105)
+++ pkg/DEoptim/src/evaluate.c	2012-07-01 13:40:30 UTC (rev 106)
@@ -25,20 +25,21 @@
 {
    SEXP sexp_fvec, fn;
    double *d_result;
-   int *i_result;
+   int P = 0;
 
-   PROTECT(fn = lang3(fcall, parMat, R_DotsSymbol));
+   PROTECT(fn = lang3(fcall, parMat, R_DotsSymbol)); P++;
       (*l_nfeval)++;  /* increment function evaluation count */
 
-   PROTECT(sexp_fvec = eval(fn, env));
+   PROTECT(sexp_fvec = eval(fn, env)); P++;
    int nr = nrows(sexp_fvec);
    if(nr != nrows(parMat))
      error("objective function result has different length than parameter matrix");
    switch(TYPEOF(sexp_fvec)) {
      case INTSXP:
-       i_result = INTEGER(sexp_fvec);
+       PROTECT(sexp_fvec = coerceVector(sexp_fvec, REALSXP)); P++;
+       d_result = REAL(sexp_fvec);
        for(int i=0; i < nr; i++) {
-         if(ISNAN(i_result[i]))
+         if(ISNAN(d_result[i]))
            error("NaN value of objective function! \nPerhaps adjust the bounds.");
        }
        break;
@@ -53,6 +54,6 @@
        error("unsupported objective function return value");
        break;
    }
-   UNPROTECT(2);
+   UNPROTECT(P);
    return(sexp_fvec);
 }