The R Project SVN R

Rev

Rev 33125 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 33125 Rev 33297
Line 90... Line 90...
90 
 
 90 
 
91 
    /* xmin */
 91 
    /* xmin */
92 
 
 92 
 
93 
    xmin = asReal(CAR(args));
 93 
    xmin = asReal(CAR(args));
94 
    if (!R_FINITE(xmin))
 94 
    if (!R_FINITE(xmin))
95 
	errorcall(call, _("invalid xmin value"));
 95 
	errorcall(call, _("invalid 'xmin' value"));
96 
    args = CDR(args);
 96 
    args = CDR(args);
97 
 
 97 
 
98 
    /* xmax */
 98 
    /* xmax */
99 
 
 99 
 
100 
    xmax = asReal(CAR(args));
 100 
    xmax = asReal(CAR(args));
101 
    if (!R_FINITE(xmax))
 101 
    if (!R_FINITE(xmax))
102 
	errorcall(call, _("invalid xmax value"));
 102 
	errorcall(call, _("invalid 'xmax' value"));
103 
    if (xmin >= xmax)
 103 
    if (xmin >= xmax)
104 
	errorcall(call, _("xmin not less than xmax"));
 104 
	errorcall(call, _("'xmin' not less than 'xmax'"));
105 
    args = CDR(args);
 105 
    args = CDR(args);
106 
 
 106 
 
107 
    /* tol */
 107 
    /* tol */
108 
 
 108 
 
109 
    tol = asReal(CAR(args));
 109 
    tol = asReal(CAR(args));
110 
    if (!R_FINITE(tol) || tol <= 0.0)
 110 
    if (!R_FINITE(tol) || tol <= 0.0)
111 
	errorcall(call, _("invalid tol value"));
 111 
	errorcall(call, _("invalid 'tol' value"));
112 
 
 112 
 
113 
    info.R_env = rho;
 113 
    info.R_env = rho;
114 
    PROTECT(info.R_fcall = lang2(v, R_NilValue));
 114 
    PROTECT(info.R_fcall = lang2(v, R_NilValue));
115 
    PROTECT(res = allocVector(REALSXP, 1));
 115 
    PROTECT(res = allocVector(REALSXP, 1));
116 
    SETCADR(info.R_fcall, allocVector(REALSXP, 1));
 116 
    SETCADR(info.R_fcall, allocVector(REALSXP, 1));
Line 176... Line 176...
176 
 
 176 
 
177 
    /* xmin */
 177 
    /* xmin */
178 
 
 178 
 
179 
    xmin = asReal(CAR(args));
 179 
    xmin = asReal(CAR(args));
180 
    if (!R_FINITE(xmin))
 180 
    if (!R_FINITE(xmin))
181 
	errorcall(call, _("invalid xmin value"));
 181 
	errorcall(call, _("invalid 'xmin' value"));
182 
    args = CDR(args);
 182 
    args = CDR(args);
183 
 
 183 
 
184 
    /* xmax */
 184 
    /* xmax */
185 
 
 185 
 
186 
    xmax = asReal(CAR(args));
 186 
    xmax = asReal(CAR(args));
187 
    if (!R_FINITE(xmax))
 187 
    if (!R_FINITE(xmax))
188 
	errorcall(call, _("invalid xmax value"));
 188 
	errorcall(call, _("invalid 'xmax' value"));
189 
    if (xmin >= xmax)
 189 
    if (xmin >= xmax)
190 
	errorcall(call, _("xmin not less than xmax"));
 190 
	errorcall(call, _("'xmin' not less than 'xmax'"));
191 
    args = CDR(args);
 191 
    args = CDR(args);
192 
 
 192 
 
193 
    /* tol */
 193 
    /* tol */
194 
 
 194 
 
195 
    tol = asReal(CAR(args));
 195 
    tol = asReal(CAR(args));
196 
    if (!R_FINITE(tol) || tol <= 0.0)
 196 
    if (!R_FINITE(tol) || tol <= 0.0)
197 
	errorcall(call, _("invalid tol value"));
 197 
	errorcall(call, _("invalid 'tol' value"));
198 
    args = CDR(args);
 198 
    args = CDR(args);
199 
 
 199 
 
200 
    /* maxiter */
 200 
    /* maxiter */
201 
    iter = asInteger(CAR(args));
 201 
    iter = asInteger(CAR(args));
202 
    if (iter <= 0)
 202 
    if (iter <= 0)
203 
	errorcall(call, _("maxiter must be positive"));
 203 
	errorcall(call, _("'maxiter' must be positive"));
204 
 
 204 
 
205 
    info.R_env = rho;
 205 
    info.R_env = rho;
206 
    PROTECT(info.R_fcall = lang2(v, R_NilValue)); /* the info used in fcn2() */
 206 
    PROTECT(info.R_fcall = lang2(v, R_NilValue)); /* the info used in fcn2() */
207 
    SETCADR(info.R_fcall, allocVector(REALSXP, 1));
 207 
    SETCADR(info.R_fcall, allocVector(REALSXP, 1));
208 
    PROTECT(res = allocVector(REALSXP, 3));
 208 
    PROTECT(res = allocVector(REALSXP, 3));
Line 340... Line 340...
340 
	return;
 340 
	return;
341 
    }
 341 
    }
342 
				/* calculate for a new value of x */
 342 
				/* calculate for a new value of x */
343 
    s = CADR(R_fcall);
 343 
    s = CADR(R_fcall);
344 
    for (i = 0; i < n; i++) {
 344 
    for (i = 0; i < n; i++) {
345 
	if (!R_FINITE(x[i])) error(_("non-finite value supplied by nlm"));
 345 
	if (!R_FINITE(x[i])) error(_("non-finite value supplied by 'nlm'"));
346 
	REAL(s)[i] = x[i];
 346 
	REAL(s)[i] = x[i];
347 
    }
 347 
    }
348 
    s = eval(state->R_fcall, state->R_env);
 348 
    s = eval(state->R_fcall, state->R_env);
349 
    switch(TYPEOF(s)) {
 349 
    switch(TYPEOF(s)) {
350 
    case INTSXP:
 350 
    case INTSXP: