diff --git a/DESCRIPTION b/DESCRIPTION index 6025e09..fb0c499 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: diversitree -Version: 0.10-0 +Version: 0.10-1 Title: Comparative 'Phylogenetic' Analyses of Diversification Authors@R: c(person("Richard G.", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), diff --git a/man/find.mle.Rd b/man/find.mle.Rd index c0144fd..355e2c1 100644 --- a/man/find.mle.Rd +++ b/man/find.mle.Rd @@ -73,17 +73,17 @@ find.mle(func, x.init, method, ...) Different \code{method} arguments take different arguments passed through \code{...} to control their behaviour: - \code{method="optim"}: Uses \R's \code{\link{optim}} function for the + \code{method="optim"}: Uses \R's \code{optim} function for the optimisation. This allows access to a variety of general purpose optimisation algorithms. The method \emph{within} \code{optim} can be chosen via the argument \code{optim.method}, which is set to "L-BFGS-B" by default (box constrained quasi-Newton optimisation). This should be suitable for most uses. See the \code{method} argument - of \code{\link{optim}} for other possibilities. If \code{"L-BFGS-B"} + of \code{optim} for other possibilities. If \code{"L-BFGS-B"} is used, then upper and lower bounds may be specified by the arguments \code{lower} and \code{upper}. The argument \code{control} can be used to specify other control parameters for the algorithms - see - \code{\link{optim}} for details. Most of the \code{optim} algorithms + \code{optim} for details. Most of the \code{optim} algorithms require finite values be returned at every evaluated point. This is often not possible (extreme values of parameters or particular combinations may have zero likelihood and therefore -Inf @@ -99,13 +99,13 @@ find.mle(func, x.init, method, ...) approximation of derivatives and seems to find the global optimum more reliably (though often less precisely). Additional arguments are \code{control} to control aspects of the search (see - \code{\link{subplex}} for details). The argument \code{fail.value} + \code{subplex} for details). The argument \code{fail.value} can be used as in \code{method="optim"}, but by default \code{-Inf} will be used on failure to evaluate, which is generally appropriate. - \code{method="nlminb"}: Uses the function \code{\link{nlminb}} for + \code{method="nlminb"}: Uses the function \code{nlminb} for optimisation, so that optimising a Mk2/Mkn likelihood function behaves - as similarly as possible to \code{ape}'s \code{\link{ace}} function. + as similarly as possible to \code{ape}'s \code{ace} function. As for \code{method="optim"}, lower and upper bounds on parameters may be specified via \code{lower} and \code{upper}. \code{fail.value} can be used to control behaviour on evaluation failure, but like @@ -114,24 +114,24 @@ find.mle(func, x.init, method, ...) - see \code{link{nlminb} for details}. This function is not generally recommended for use. - \code{method="nlm"}: Uses the function \code{\link{nlm}} for + \code{method="nlm"}: Uses the function \code{nlm} for optimisation, so that optimising a birth-death likelihood function behaves as similarly as possible to \code{ape}'s - \code{\link{birthdeath}} function. Takes the same additional + \code{birthdeath} function. Takes the same additional arguments as \code{method="nlminb"} (except that \code{fail.value} behaves as for \code{method="optim"}). Like \code{method="nlminb"}, this is not recommended for general use. \code{code} and \code{logLik} methods exist for \code{fit.mle} objects so that parameters and log-likelihoods may be extracted. This also - allows use with \code{\link{AIC}}. + allows use with \code{AIC}. Simple model comparison by way of likelihood ratio tests can be - performed with \code{\link{anova}}. See Examples for usage. + performed with \code{anova}. See Examples for usage. } \section{Model comparison}{ - The \code{\link{anova}} function carries out likelihood ratio tests. + The \code{anova} function carries out likelihood ratio tests. There are a few possible configurations. First, the first fit provided could be the focal fit, and all other @@ -146,7 +146,7 @@ find.mle(func, x.init, method, ...) strictly decreasing in parameters (D nested in C, C nested in B, ...). In both cases, nestedness is checked. First, the "class" of the - fitted object must match. Second, the \code{\link{argnames}} of the + fitted object must match. Second, the \code{argnames} of the likelihood function of a sub model must all appear in the \code{argnames} of the parent model. There are some cases where this second condition may not be satisfied and yet the comparison is valid @@ -202,14 +202,14 @@ coef(fit) # Named vector of six parameters logLik(fit) # -659.93 AIC(fit) # 1331.86 -## find.mle works with constrained models (see \link{constrain}). Here +## find.mle works with constrained models (see constrain). Here ## the two speciation rates are constrained to be the same as each ## other. lik.l <- constrain(lik, lambda0 ~ lambda1) fit.l <- find.mle(lik.l, pars[-2]) logLik(fit.l) # 663.41 -## Compare the models with \link{anova} - this shows that the more +## Compare the models with anova - this shows that the more ## complicated model with two separate speciation rates fits ## significantly better than the simpler model with equal rates ## (p=0.008). diff --git a/man/make.mkn.Rd b/man/make.mkn.Rd index 03a7a2f..820a5b0 100644 --- a/man/make.mkn.Rd +++ b/man/make.mkn.Rd @@ -158,7 +158,7 @@ fit.mkn[1:2] ## These are the same (except for the naming of arguments) all.equal(fit.mkn[-7], fit.mk2[-7], check.attr=FALSE, tolerance=1e-7) -## Equivalence to ape's \link{ace} function: +## Equivalence to ape's ace function: model <- matrix(c(0, 2, 1, 0), 2) fit.ape <- ace(phy$tip.state, phy, "discrete", model=model, ip=p) diff --git a/src/GslOdeR.cpp b/src/GslOdeR.cpp index eae4e47..8d7f337 100644 --- a/src/GslOdeR.cpp +++ b/src/GslOdeR.cpp @@ -26,7 +26,7 @@ SEXP GslOdeR::target(double t, SEXP y) { void GslOdeR::derivs(double t, const double y[], double dydt[]) { // It is possible that we could allocate the space at construction - // (though I think that allocVector could lead to eventual garbage + // (though I think that Rf_allocVector could lead to eventual garbage // collection as we can't protect it). Alternatively, // Rcpp::NumericVector followed by Rcpp::wrap might be less ugly. // That would require a change in target() to return diff --git a/src/TimeMachine.cpp b/src/TimeMachine.cpp index 3f969da..e8d4217 100644 --- a/src/TimeMachine.cpp +++ b/src/TimeMachine.cpp @@ -36,7 +36,7 @@ TimeMachine::TimeMachine(std::vector names, void TimeMachine::set(std::vector pars) { if (pars.size() != np_in) - error("Expected %d parameters, recieved %d", (int)np_in, (int)pars.size()); + Rf_error("Expected %d parameters, recieved %d", (int)np_in, (int)pars.size()); // Only go through the extra effort below if the parameters differ. if ( pars == p_in ) return; @@ -178,9 +178,9 @@ TimeMachineFunction::TimeMachineFunction(std::string name_, f = &tm_fun_spline; np = 2; if ( spline == NULL ) - error("Should not be able to get here!"); + Rf_error("Should not be able to get here!"); } else { - error("Unknown function type %s", func_name.c_str()); + Rf_error("Unknown function type %s", func_name.c_str()); } p_in.resize(np); @@ -201,7 +201,7 @@ double TimeMachineFunction::check_ok(double x) { if ( truncate ) x = 0; else if ( nonnegative ) - error("Value of %s (%s) must be nonnegative", + Rf_error("Value of %s (%s) must be nonnegative", variable_name.c_str(), func_name.c_str()); } return x; diff --git a/src/asr-joint.c b/src/asr-joint.c index a7e5927..20b7778 100644 --- a/src/asr-joint.c +++ b/src/asr-joint.c @@ -1,9 +1,6 @@ #include #include -/* Ripped from the R code; I can probably use this to speed things up - later? - If I drop the permutations or save them in the main - section this will be a bit faster... */ int ProbSampleOne_tmp(int n, double *p, int *perm) { double rU, tot = 0; int i, j; @@ -43,7 +40,7 @@ SEXP r_sample(SEXP r_root_p) { ret = ProbSampleOne_tmp(k, pr, perm); PutRNGstate(); - return ScalarInteger(ret); + return Rf_ScalarInteger(ret); } @@ -66,7 +63,7 @@ SEXP r_do_asr_joint(SEXP r_k, SEXP r_order, SEXP r_parent, int idx, i, j, l; GetRNGstate(); - PROTECT(ret = allocVector(INTSXP, len)); + PROTECT(ret = Rf_allocVector(INTSXP, len)); states = INTEGER(ret); /* Sample root */ diff --git a/src/continuous.c b/src/continuous.c index 2989428..66472db 100644 --- a/src/continuous.c +++ b/src/continuous.c @@ -19,7 +19,7 @@ SEXP r_make_dt_obj_cont(SEXP cache, SEXP r_ic, SEXP r_br) { dt_obj_cont *obj; SEXP extPtr; - obj = (dt_obj_cont *)Calloc(1, dt_obj_cont); + obj = (dt_obj_cont *)R_Calloc(1, dt_obj_cont); obj->neq = neq; obj->n_out = LENGTH(getListElement(cache, "len")); obj->np = np; @@ -29,9 +29,9 @@ SEXP r_make_dt_obj_cont(SEXP cache, SEXP r_ic, SEXP r_br) { obj->br = br; /* Set up storage */ - obj->init = (double *)Calloc(obj->n_out * neq, double); - obj->base = (double *)Calloc(obj->n_out * neq, double); - obj->lq = (double *)Calloc(obj->n_out, double); + obj->init = (double *)R_Calloc(obj->n_out * neq, double); + obj->base = (double *)R_Calloc(obj->n_out * neq, double); + obj->lq = (double *)R_Calloc(obj->n_out, double); /* Set up tips and internal branches */ dt_cont_setup_tips(obj, cache); @@ -49,22 +49,22 @@ SEXP r_make_dt_obj_cont(SEXP cache, SEXP r_ic, SEXP r_br) { static void dt_obj_cont_finalize(SEXP extPtr) { dt_obj_cont *obj = (dt_obj_cont*)R_ExternalPtrAddr(extPtr); - Free(obj->init); - Free(obj->base); - Free(obj->lq); + R_Free(obj->init); + R_Free(obj->base); + R_Free(obj->lq); /* tips */ - Free(obj->tip_y); - Free(obj->tip_len); - Free(obj->tip_target); + R_Free(obj->tip_y); + R_Free(obj->tip_len); + R_Free(obj->tip_target); /* internals */ - Free(obj->order); - Free(obj->children); - Free(obj->len); - Free(obj->depth); + R_Free(obj->order); + R_Free(obj->children); + R_Free(obj->len); + R_Free(obj->depth); - Free(obj); + R_Free(obj); } void dt_cont_setup_tips(dt_obj_cont *obj, SEXP cache) { @@ -78,10 +78,10 @@ void dt_cont_setup_tips(dt_obj_cont *obj, SEXP cache) { tip_target = INTEGER(tip_target_r); n_tip = obj->n_tip = LENGTH(tip_target_r); - if ( nrows(tip_y) != neq || ncols(tip_y) != n_tip ) - error("Incorrect tip state dimensions"); + if ( Rf_nrows(tip_y) != neq || Rf_ncols(tip_y) != n_tip ) + Rf_error("Incorrect tip state dimensions"); - obj->tip_target = (int *)Calloc(n_tip, int); + obj->tip_target = (int *)R_Calloc(n_tip, int); memcpy(obj->tip_target, tip_target, n_tip*sizeof(int)); for ( i = 0; i < n_tip; i++ ) { @@ -104,10 +104,10 @@ void dt_cont_setup_internal(dt_obj_cont *obj, SEXP cache) { n_out = obj->n_out; n_int = obj->n_int = LENGTH(order) - 1; - obj->order = (int *)Calloc(n_int, int); - obj->children = (int *)Calloc(n_out*2, int); - obj->len = (double *)Calloc(n_out, double); - obj->depth = (double *)Calloc(n_out, double); + obj->order = (int *)R_Calloc(n_int, int); + obj->children = (int *)R_Calloc(n_out*2, int); + obj->len = (double *)R_Calloc(n_out, double); + obj->depth = (double *)R_Calloc(n_out, double); memcpy(obj->order, INTEGER(order), n_int*sizeof(int)); memcpy(obj->children, INTEGER(children), 2*n_out*sizeof(int)); @@ -130,7 +130,7 @@ SEXP r_all_branches_cont(SEXP extPtr, SEXP r_pars) { SEXP ret, ret_vals; if ( obj == NULL ) - error("Corrupt pointer (are you using multicore?)"); + Rf_error("Corrupt pointer (are you using multicore?)"); ic = obj->ic; br = obj->br; @@ -148,7 +148,7 @@ SEXP r_all_branches_cont(SEXP extPtr, SEXP r_pars) { lq = obj->lq; if ( LENGTH(r_pars) != obj->np ) - error("Incorrect length parameters. Expected %d, got %d", + Rf_error("Incorrect length parameters. Expected %d, got %d", obj->np, LENGTH(r_pars)); for ( i = 0; i < n_tip; i++ ) { @@ -176,9 +176,9 @@ SEXP r_all_branches_cont(SEXP extPtr, SEXP r_pars) { for ( i = 0; i < obj->n_out; i++ ) tot += lq[i]; - PROTECT(ret = allocVector(VECSXP, 2)); - PROTECT(ret_vals = allocVector(REALSXP, neq)); - SET_VECTOR_ELT(ret, 0, ScalarReal(tot)); + PROTECT(ret = Rf_allocVector(VECSXP, 2)); + PROTECT(ret_vals = Rf_allocVector(REALSXP, neq)); + SET_VECTOR_ELT(ret, 0, Rf_ScalarReal(tot)); SET_VECTOR_ELT(ret, 1, ret_vals); memcpy(REAL(ret_vals), init + obj->root * neq, neq*sizeof(double)); UNPROTECT(2); @@ -193,11 +193,11 @@ SEXP r_get_vals_cont(SEXP extPtr) { int n_out = obj->n_out, neq = obj->neq; int i, idx; - PROTECT(ret = allocVector(VECSXP, 3)); - PROTECT(r_init = allocMatrix(REALSXP, neq, n_out)); - PROTECT(r_base = allocMatrix(REALSXP, neq, n_out)); + PROTECT(ret = Rf_allocVector(VECSXP, 3)); + PROTECT(r_init = Rf_allocMatrix(REALSXP, neq, n_out)); + PROTECT(r_base = Rf_allocMatrix(REALSXP, neq, n_out)); - PROTECT(lq = allocVector(REALSXP, n_out)); + PROTECT(lq = Rf_allocVector(REALSXP, n_out)); SET_VECTOR_ELT(ret, 0, r_init); SET_VECTOR_ELT(ret, 1, r_base); SET_VECTOR_ELT(ret, 2, lq); @@ -325,7 +325,7 @@ SEXP r_dt_cont_reset_tips(SEXP extPtr, SEXP tip_y) { double *y = REAL(tip_y); int i, idx, neq = obj->neq, n_tip = obj->n_tip; if (LENGTH(tip_y) != neq * n_tip) - error("Wrong length tip_y - expected %d, got %d", + Rf_error("Wrong length tip_y - expected %d, got %d", neq * n_tip, LENGTH(tip_y)); for (i = 0; i < n_tip; i++) { diff --git a/src/hdr.c b/src/hdr.c index 064d19e..7933438 100644 --- a/src/hdr.c +++ b/src/hdr.c @@ -1,5 +1,6 @@ #include #include +#include /* for DBL_EPSILON */ #include "util-splines.h" @@ -21,7 +22,7 @@ SEXP r_hdr(SEXP x, SEXP y, SEXP alpha) { dat->w = 1-a; xl = RSRC_Brent_fmin(0, a, fn, (void *)dat, tol); - PROTECT(ret = allocVector(REALSXP, 2)); + PROTECT(ret = Rf_allocVector(REALSXP, 2)); REAL(ret)[0] = dt_spline_eval1(dat->spline, xl); REAL(ret)[1] = dt_spline_eval1(dat->spline, xl+dat->w); UNPROTECT(1); diff --git a/src/mkn-pij.c b/src/mkn-pij.c index a94ccfa..acae2cb 100644 --- a/src/mkn-pij.c +++ b/src/mkn-pij.c @@ -119,14 +119,14 @@ SEXP r_asr_marginal_mkn(SEXP r_k, SEXP r_pars, SEXP r_nodes, int idx, i, j, k; double *vals; - if ( !isFunction(root_f) ) - error("root_f must be a function"); - if ( !isEnvironment(rho) ) - error("rho must be a function"); + if ( !Rf_isFunction(root_f) ) + Rf_error("root_f must be a function"); + if ( !Rf_isEnvironment(rho) ) + Rf_error("rho must be a function"); - PROTECT(ret = allocMatrix(REALSXP, n_states, n_nodes)); - PROTECT(cpy_root_vals = allocVector(REALSXP, neq)); - PROTECT(cpy_lq = allocVector(REALSXP, n_out)); + PROTECT(ret = Rf_allocMatrix(REALSXP, n_states, n_nodes)); + PROTECT(cpy_root_vals = Rf_allocVector(REALSXP, neq)); + PROTECT(cpy_lq = Rf_allocVector(REALSXP, n_out)); for ( i = 0; i < n_nodes; i++ ) { idx = nodes[i]; @@ -148,8 +148,8 @@ SEXP r_asr_marginal_mkn(SEXP r_k, SEXP r_pars, SEXP r_nodes, memcpy(REAL(cpy_root_vals), root_vals, neq * sizeof(double)); memcpy(REAL(cpy_lq), lq, n_out * sizeof(double)); - PROTECT(R_fcall = lang4(root_f, r_pars, cpy_root_vals, cpy_lq)); - PROTECT(tmp = eval(R_fcall, rho)); + PROTECT(R_fcall = Rf_lang4(root_f, r_pars, cpy_root_vals, cpy_lq)); + PROTECT(tmp = Rf_eval(R_fcall, rho)); vals[j] = REAL(tmp)[0]; UNPROTECT(2); } diff --git a/src/quasse-eqs-fftC.c b/src/quasse-eqs-fftC.c index 10e2a9f..f10e36a 100644 --- a/src/quasse-eqs-fftC.c +++ b/src/quasse-eqs-fftC.c @@ -54,7 +54,7 @@ SEXP r_get_x(SEXP extPtr, SEXP r_nd) { quasse_fft *obj = (quasse_fft*)R_ExternalPtrAddr(extPtr); SEXP x; int nd = INTEGER(r_nd)[0]; - PROTECT(x = allocMatrix(REALSXP, obj->nx, nd)); + PROTECT(x = Rf_allocMatrix(REALSXP, obj->nx, nd)); qf_copy_x(obj, REAL(x), nd, 0); UNPROTECT(1); return x; @@ -70,7 +70,7 @@ SEXP r_propagate_t(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, SEXP dt) { idx = lookup(nd, obj->nd, obj->n_fft); if ( idx < 0 ) - error("Failed to find nd = %d\n", nd); + Rf_error("Failed to find nd = %d\n", nd); qf_copy_x(obj, REAL(vars), nd, 1); @@ -86,7 +86,7 @@ SEXP r_propagate_t(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, SEXP dt) { obj->lambda = NULL; obj->mu = NULL; - PROTECT(ret = allocMatrix(REALSXP, obj->nx, nd)); + PROTECT(ret = Rf_allocMatrix(REALSXP, obj->nx, nd)); qf_copy_x(obj, REAL(ret), nd, 0); UNPROTECT(1); return ret; @@ -101,14 +101,14 @@ SEXP r_propagate_x(SEXP extPtr, SEXP vars, SEXP drift, SEXP diffusion, idx = lookup(nd, obj->nd, obj->n_fft); if ( idx < 0 ) - error("Failed to find nd = %d\n", nd); + Rf_error("Failed to find nd = %d\n", nd); qf_copy_x(obj, REAL(vars), nd, 1); qf_setup_kern(obj, REAL(drift)[0], REAL(diffusion)[0], REAL(dt)[0], nkl, nkr); propagate_x(obj, idx); - PROTECT(ret = allocMatrix(REALSXP, obj->nx, nd)); + PROTECT(ret = Rf_allocMatrix(REALSXP, obj->nx, nd)); qf_copy_x(obj, REAL(ret), nd, 0); UNPROTECT(1); return ret; @@ -127,12 +127,12 @@ SEXP r_do_integrate(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, double c_drift=REAL(drift)[0], c_diffusion=REAL(diffusion)[0]; int i, idx, nd; if ( obj == NULL ) - error("Corrupt QuaSSE integrator: ptr is NULL (are you using multicore?)"); + Rf_error("Corrupt QuaSSE integrator: ptr is NULL (are you using multicore?)"); nd = LENGTH(vars) / obj->nx; idx = lookup(nd, obj->nd, obj->n_fft); if ( idx < 0 ) - error("Failed to find nd = %d\n", nd); + Rf_error("Failed to find nd = %d\n", nd); qf_copy_x(obj, REAL(vars), nd, 1); @@ -148,7 +148,7 @@ SEXP r_do_integrate(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, obj->lambda = NULL; obj->mu = NULL; - PROTECT(ret = allocMatrix(REALSXP, obj->nx, nd)); + PROTECT(ret = Rf_allocMatrix(REALSXP, obj->nx, nd)); qf_copy_x(obj, REAL(ret), nd, 0); UNPROTECT(1); @@ -188,15 +188,15 @@ SEXP r_do_tips(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, int n_fft = obj->n_fft, n_fft_m1 = obj->n_fft - 1; if ( (LENGTH(vars) / obj->nx) != obj->nd[0] ) - error("Error 1\n"); + Rf_error("Error 1\n"); /* First; allocate space: All but the first cases will be nx * 2 matrices, but the final one might be a matrix itself */ - PROTECT(ret = allocVector(VECSXP, n_fft)); + PROTECT(ret = Rf_allocVector(VECSXP, n_fft)); for ( i = 0; i < n_fft_m1; i++ ) - SET_VECTOR_ELT(ret, i, allocMatrix(REALSXP, nx, 2)); + SET_VECTOR_ELT(ret, i, Rf_allocMatrix(REALSXP, nx, 2)); SET_VECTOR_ELT(ret, n_fft_m1, - allocMatrix(REALSXP, nx, obj->nd[n_fft_m1])); + Rf_allocMatrix(REALSXP, nx, obj->nd[n_fft_m1])); /* This bit proceeds exactly as r_do_integrate() */ qf_copy_x(obj, REAL(vars), LENGTH(vars) / obj->nx, 1); @@ -360,7 +360,7 @@ void do_integrate(quasse_fft *obj, int nt, int idx) { propagate_t(obj, idx); propagate_x(obj, idx); if ( ISNAN(obj->x[nkl]) ) - error("Integration failure at step %d\n", i); + Rf_error("Integration failure at step %d\n", i); } } diff --git a/src/rfftw.c b/src/rfftw.c index cba54f7..49e7a82 100644 --- a/src/rfftw.c +++ b/src/rfftw.c @@ -107,7 +107,7 @@ SEXP r_rfftw_forw(SEXP extPtr, SEXP r_x_in) { fftw_execute(obj->plan_f); - PROTECT(ret = allocVector(CPLXSXP, nyd)); + PROTECT(ret = Rf_allocVector(CPLXSXP, nyd)); /* TODO: There is a change that I should be using Rcomplex here */ y_out = (fftw_complex*)COMPLEX(ret); for ( i = 0; i < nyd; i++ ) @@ -136,7 +136,7 @@ SEXP r_rfftw_back(SEXP extPtr, SEXP r_y_in) { fftw_execute(obj->plan_b); - PROTECT(ret = allocVector(REALSXP, nxd)); + PROTECT(ret = Rf_allocVector(REALSXP, nxd)); x_out = REAL(ret); for ( i = 0; i < nxd; i++ ) x_out[i] = x[i]; @@ -149,7 +149,7 @@ SEXP r_rfftw_back(SEXP extPtr, SEXP r_y_in) { SEXP r_get_wisdom(void) { char *wisdom = fftw_export_wisdom_to_string(); SEXP ret; - PROTECT(ret = allocVector(STRSXP, 1)); + PROTECT(ret = Rf_allocVector(STRSXP, 1)); SET_STRING_ELT(ret, 0, mkChar(wisdom)); UNPROTECT(1); return ret; @@ -158,7 +158,7 @@ SEXP r_get_wisdom(void) { SEXP r_set_wisdom(SEXP r_wisdom) { const char *wisdom = CHAR(STRING_ELT(r_wisdom, 0)); SEXP ret; - PROTECT(ret = allocVector(LGLSXP, 1)); + PROTECT(ret = Rf_allocVector(LGLSXP, 1)); INTEGER(ret)[0] = fftw_import_wisdom_from_string(wisdom); UNPROTECT(1); return ret; diff --git a/src/scm-mkn.c b/src/scm-mkn.c index a96bffc..d64b54e 100644 --- a/src/scm-mkn.c +++ b/src/scm-mkn.c @@ -42,7 +42,7 @@ SEXP r_smkn_scm_run(SEXP extPtr, SEXP len, hist_t = obj->hist_t; hist_s = obj->hist_to; - PROTECT(ret = allocMatrix(REALSXP, n_hist+1, 2)); + PROTECT(ret = Rf_allocMatrix(REALSXP, n_hist+1, 2)); out_t = REAL(ret); out_s = REAL(ret) + (n_hist + 1); @@ -72,13 +72,13 @@ SEXP r_smkn_scm_run_all(SEXP extPtr, SEXP pars, SEXP r_len, int *hist_s; if ( LENGTH(r_state_beg) != n ) - error("state_beg incorrect length"); + Rf_error("state_beg incorrect length"); if ( LENGTH(r_state_end) != n ) - error("state_end incorrect length"); + Rf_error("state_end incorrect length"); smkn_set_pars(obj, REAL(pars)); - PROTECT(ret = allocVector(VECSXP, n)); + PROTECT(ret = Rf_allocVector(VECSXP, n)); GetRNGstate(); @@ -93,7 +93,7 @@ SEXP r_smkn_scm_run_all(SEXP extPtr, SEXP pars, SEXP r_len, /* List assignment protects the result so explicit PROTECT/UNPROTECT not neededed */ - SET_VECTOR_ELT(ret, i, allocMatrix(REALSXP, n_hist_out, 2)); + SET_VECTOR_ELT(ret, i, Rf_allocMatrix(REALSXP, n_hist_out, 2)); hist = VECTOR_ELT(ret, i); out_t = REAL(hist); out_s = REAL(hist) + n_hist_out; @@ -133,16 +133,16 @@ SEXP smkn_slim(SEXP obj) { SEXP r_idx, hist, ret; for ( i = 0; i < n; i++ ) - if ( nrows(VECTOR_ELT(obj, i)) > 0 ) + if ( Rf_nrows(VECTOR_ELT(obj, i)) > 0 ) nkeep++; - PROTECT(ret = allocVector(VECSXP, 2)); - PROTECT(r_idx = allocVector(INTSXP, nkeep)); - PROTECT(hist = allocVector(VECSXP, nkeep)); + PROTECT(ret = Rf_allocVector(VECSXP, 2)); + PROTECT(r_idx = Rf_allocVector(INTSXP, nkeep)); + PROTECT(hist = Rf_allocVector(VECSXP, nkeep)); idx = INTEGER(r_idx); for ( i = 0; i < n; i++ ) - if ( nrows(VECTOR_ELT(obj, i)) > 0 ) { + if ( Rf_nrows(VECTOR_ELT(obj, i)) > 0 ) { idx[j] = i + 1; SET_VECTOR_ELT(hist, j, VECTOR_ELT(obj, i)); j++; @@ -157,25 +157,25 @@ SEXP smkn_slim(SEXP obj) { /* Functions required by _alloc() */ smkn_info* smkn_alloc(int k, int n_hist) { - smkn_info *obj = Calloc(1, smkn_info); + smkn_info *obj = R_Calloc(1, smkn_info); int np = k*(k - 1); #ifdef VERBOSE Rprintf("Allocating with k = %d, n_hist = %d\n", k, n_hist); #endif obj->k = k; - obj->pars = Calloc(np, double); - obj->r = Calloc(k, double); - obj->cp = Calloc(np, double); - obj->perm = Calloc(np, int); + obj->pars = R_Calloc(np, double); + obj->r = R_Calloc(k, double); + obj->cp = R_Calloc(np, double); + obj->perm = R_Calloc(np, int); obj->n_hist = 0; obj->n_hist_max = n_hist; - obj->hist_from = Calloc(n_hist, int); - obj->hist_to = Calloc(n_hist, int); + obj->hist_from = R_Calloc(n_hist, int); + obj->hist_to = R_Calloc(n_hist, int); - obj->hist_t = Calloc(n_hist, double); + obj->hist_t = R_Calloc(n_hist, double); return obj; } @@ -184,19 +184,19 @@ void smkn_cleanup(smkn_info *obj) { #ifdef VERBOSE Rprintf("Cleaning permanantly sized objects\n"); #endif - Free(obj->pars); - Free(obj->r); - Free(obj->cp); - Free(obj->perm); + R_Free(obj->pars); + R_Free(obj->r); + R_Free(obj->cp); + R_Free(obj->perm); #ifdef VERBOSE Rprintf("Cleaning variably sized objects\n"); #endif - Free(obj->hist_from); - Free(obj->hist_to); - Free(obj->hist_t); + R_Free(obj->hist_from); + R_Free(obj->hist_to); + R_Free(obj->hist_t); - Free(obj); + R_Free(obj); } static void smkn_info_finalize(SEXP extPtr) { @@ -244,7 +244,7 @@ int smkn_scm_run(smkn_info *obj, double len, } if ( niter == SCM_MAX_ATTEMPTS ) - error("Realisation failed (too many attempts)"); + Rf_error("Realisation failed (too many attempts)"); return 1; } @@ -331,11 +331,11 @@ void smkn_grow_hist(smkn_info *obj) { obj->n_hist_max, n); #endif if ( n > SMKN_MAX_SIZE ) - error("Exceeding maximum allowed history size"); + Rf_error("Exceeding maximum allowed history size"); obj->n_hist_max = n; - obj->hist_from = Realloc(obj->hist_from, n, int); - obj->hist_to = Realloc(obj->hist_to, n, int); - obj->hist_t = Realloc(obj->hist_t, n, double); + obj->hist_from = R_Realloc(obj->hist_from, n, int); + obj->hist_to = R_Realloc(obj->hist_to, n, int); + obj->hist_t = R_Realloc(obj->hist_t, n, double); } diff --git a/src/simulate-bisse.c b/src/simulate-bisse.c index 37b3ed8..029766a 100644 --- a/src/simulate-bisse.c +++ b/src/simulate-bisse.c @@ -177,7 +177,7 @@ void simulate_bisse(double *pars, int max_taxa, double max_t, } } if ( lineage < 0 ) - error("Something terrible might happen here."); + Rf_error("Something terrible might happen here."); /* And pick a type of event */ /* TODO: This copy is only necessary when directly using @@ -267,15 +267,15 @@ SEXP simulate_bisse2(SEXP r_pars, SEXP r_max_taxa, SEXP r_max_t, SEXP ret; double t_start[1]; - PROTECT(parent = allocVector(INTSXP, n)); - PROTECT(states = allocVector(INTSXP, n)); - PROTECT(extinct = allocVector(LGLSXP, n)); - PROTECT(split = allocVector(LGLSXP, n)); + PROTECT(parent = Rf_allocVector(INTSXP, n)); + PROTECT(states = Rf_allocVector(INTSXP, n)); + PROTECT(extinct = Rf_allocVector(LGLSXP, n)); + PROTECT(split = Rf_allocVector(LGLSXP, n)); - PROTECT(start = allocVector(INTSXP, n)); - PROTECT(len = allocVector(INTSXP, n)); - PROTECT(hist = allocVector(REALSXP, 3*n)); - PROTECT(hist_t = allocVector(REALSXP, n)); + PROTECT(start = Rf_allocVector(INTSXP, n)); + PROTECT(len = Rf_allocVector(INTSXP, n)); + PROTECT(hist = Rf_allocVector(REALSXP, 3*n)); + PROTECT(hist_t = Rf_allocVector(REALSXP, n)); n_entries = 1; t_start[0] = 0.0; @@ -298,11 +298,11 @@ SEXP simulate_bisse2(SEXP r_pars, SEXP r_max_taxa, SEXP r_max_t, t_start); if ( t_start[0] < 0 ) { - error("need to do this still..."); + Rf_error("need to do this still..."); } } - PROTECT(ret = allocVector(VECSXP, 10)); + PROTECT(ret = Rf_allocVector(VECSXP, 10)); SET_VECTOR_ELT(ret, 1, len); SET_VECTOR_ELT(ret, 2, parent); SET_VECTOR_ELT(ret, 3, diff --git a/src/util-splines.c b/src/util-splines.c index e2252e0..7c8d56c 100644 --- a/src/util-splines.c +++ b/src/util-splines.c @@ -27,7 +27,7 @@ void RSRC_fmm_spline(int n, double *x, double *y, x--; y--; b--; c--; d--; if(n < 2) { - error("Too few points"); + Rf_error("Too few points"); } if(n < 3) { @@ -135,14 +135,14 @@ void RSRC_fmm_spline_eval(int nu, double *u, double *v, dt_spline* make_dt_spline(int nx, double *x, double *y, int deriv) { double *b, *c, *d; int i; - dt_spline *obj = (dt_spline *)Calloc(1, dt_spline); + dt_spline *obj = (dt_spline *)R_Calloc(1, dt_spline); obj->nx = nx; - obj->x = (double*) Calloc(nx, double); - obj->y = (double*) Calloc(nx, double); - obj->b = b = (double*) Calloc(nx, double); - obj->c = c = (double*) Calloc(nx, double); - obj->d = d = (double*) Calloc(nx, double); + obj->x = (double*) R_Calloc(nx, double); + obj->y = (double*) R_Calloc(nx, double); + obj->b = b = (double*) R_Calloc(nx, double); + obj->c = c = (double*) R_Calloc(nx, double); + obj->d = d = (double*) R_Calloc(nx, double); memcpy(obj->x, x, nx * sizeof(double)); memcpy(obj->y, y, nx * sizeof(double)); @@ -162,13 +162,13 @@ dt_spline* make_dt_spline(int nx, double *x, double *y, int deriv) { } void cleanup_dt_spline(dt_spline *obj) { - Free(obj->x); - Free(obj->y); - Free(obj->b); - Free(obj->c); - Free(obj->d); + R_Free(obj->x); + R_Free(obj->y); + R_Free(obj->b); + R_Free(obj->c); + R_Free(obj->d); - Free(obj); + R_Free(obj); } static void dt_spline_finalize(SEXP extPtr); @@ -206,7 +206,7 @@ SEXP r_dt_spline_eval(SEXP extPtr, SEXP u) { dt_spline *obj = (dt_spline*)R_ExternalPtrAddr(extPtr); SEXP ret; - PROTECT(ret = allocVector(REALSXP, nu)); + PROTECT(ret = Rf_allocVector(REALSXP, nu)); dt_spline_eval(obj, REAL(u), nu, REAL(ret)); UNPROTECT(1); return ret; diff --git a/src/util.c b/src/util.c index cd47e13..cd20f3e 100644 --- a/src/util.c +++ b/src/util.c @@ -60,19 +60,19 @@ void r_gemm2(double *x, int *nrx, int *ncx, SEXP r_matrix_to_list(SEXP r_m) { SEXP ret, tmp; - int i, j, k, nr = nrows(r_m), nc = ncols(r_m); + int i, j, k, nr = Rf_nrows(r_m), nc = Rf_ncols(r_m); double *in, *out; in = REAL(r_m); - PROTECT(ret = allocVector(VECSXP, nr)); + PROTECT(ret = Rf_allocVector(VECSXP, nr)); for ( i = 0; i < nr; i++ ) { /* I believe that I don't have to protect agressively here; otherwise something like below would be needed. - PROTECT(tmp = allocVector(REALSXP, nc)); + PROTECT(tmp = Rf_allocVector(REALSXP, nc)); SET_VECTOR_ELT(ret, i, tmp); UNPROTECT(1); out = REAL(tmp); @@ -80,7 +80,7 @@ SEXP r_matrix_to_list(SEXP r_m) { another option, which definitely does not need garbage collection, is: - SET_VECTOR_ELT(ret, i, allocVector(REALSXP, nc)); + SET_VECTOR_ELT(ret, i, Rf_allocVector(REALSXP, nc)); out = REAL(VECTOR_ELT(ret, i)); which falls somewhere between the two approaches in speed. @@ -88,7 +88,7 @@ SEXP r_matrix_to_list(SEXP r_m) { However, I've run this under gctorture, and it seems not to crash, which is a good sign. */ - SET_VECTOR_ELT(ret, i, tmp = allocVector(REALSXP, nc)); + SET_VECTOR_ELT(ret, i, tmp = Rf_allocVector(REALSXP, nc)); out = REAL(tmp); for ( j = 0, k = i; j < nc; j++, k+= nr ) @@ -102,24 +102,24 @@ SEXP r_matrix_to_list(SEXP r_m) { /* Utility function for accessing list elements by name. This is needed to stop the argument list getting out of control */ SEXP getListElement(SEXP list, const char *str) { - SEXP elmt = R_NilValue, names = getAttrib(list, R_NamesSymbol); + SEXP elmt = R_NilValue, names = Rf_getAttrib(list, R_NamesSymbol); int i; - for ( i = 0; i < length(list); i++ ) + for ( i = 0; i < Rf_length(list); i++ ) if ( strcmp(CHAR(STRING_ELT(names, i)), str) == 0 ) { elmt = VECTOR_ELT(list, i); break; } if ( elmt == R_NilValue ) - error("%s missing from list", str); + Rf_error("%s missing from list", str); return elmt; } SEXP getListElementIfThere(SEXP list, const char *str) { - SEXP elmt = R_NilValue, names = getAttrib(list, R_NamesSymbol); + SEXP elmt = R_NilValue, names = Rf_getAttrib(list, R_NamesSymbol); int i; - for ( i = 0; i < length(list); i++ ) + for ( i = 0; i < Rf_length(list); i++ ) if ( strcmp(CHAR(STRING_ELT(names, i)), str) == 0 ) { elmt = VECTOR_ELT(list, i); break; @@ -134,12 +134,12 @@ void descendants_flag(int node, int *edge, int nedge, int ntip, int *flag); SEXP r_descendants(SEXP node, SEXP edge, SEXP ntip) { - int nedge = nrows(edge), *desc = (int *)R_alloc(nedge, sizeof(int)); + int nedge = Rf_nrows(edge), *desc = (int *)R_alloc(nedge, sizeof(int)); int n, *ret_c, node_c = INTEGER(node)[0]; SEXP ret; n = descendants(node_c, INTEGER(edge), nedge, INTEGER(ntip)[0], desc); - PROTECT(ret = allocVector(INTSXP, n+1)); + PROTECT(ret = Rf_allocVector(INTSXP, n+1)); ret_c = INTEGER(ret); ret_c[0] = node_c; memcpy(ret_c + 1, desc, n*sizeof(int)); @@ -166,11 +166,11 @@ int descendants(int node, int *edge, int nedge, int ntip, int *desc) { } SEXP r_descendants_flag(SEXP node, SEXP edge, SEXP ntip) { - int nedge = nrows(edge); + int nedge = Rf_nrows(edge); int i, *ret_c, node_c = INTEGER(node)[0]; int *to = INTEGER(edge) + nedge; SEXP ret; - PROTECT(ret = allocVector(LGLSXP, nedge)); + PROTECT(ret = Rf_allocVector(LGLSXP, nedge)); ret_c = INTEGER(ret); for ( i = 0; i < nedge; i++ ) ret_c[i] = to[i] == node_c; @@ -194,7 +194,7 @@ void descendants_flag(int node, int *edge, int nedge, int ntip, } SEXP r_descendants_idx(SEXP node, SEXP edge, SEXP ntip) { - int nedge = nrows(edge); + int nedge = Rf_nrows(edge); SEXP ret, flag; int *flag_c, *tmp = (int*)R_alloc(nedge, sizeof(int)); int i, n=0; @@ -205,7 +205,7 @@ SEXP r_descendants_idx(SEXP node, SEXP edge, SEXP ntip) { if ( flag_c[i] ) tmp[n++] = i + 1; - PROTECT(ret = allocVector(INTSXP, n)); + PROTECT(ret = Rf_allocVector(INTSXP, n)); memcpy(INTEGER(ret), tmp, n*sizeof(int)); UNPROTECT(2); @@ -214,10 +214,10 @@ SEXP r_descendants_idx(SEXP node, SEXP edge, SEXP ntip) { SEXP r_check_ptr_not_null(SEXP extPtr) { if ( TYPEOF(extPtr) != EXTPTRSXP ) - error("Recieved non-pointer"); + Rf_error("Recieved non-pointer"); if ( R_ExternalPtrAddr(extPtr) == NULL ) - error("Recieved NULL pointer"); - return ScalarLogical(1); + Rf_error("Recieved NULL pointer"); + return Rf_ScalarLogical(1); } void handler_pass_to_R(const char *reason,