SEXP kmeansRNumericMatrix(SEXP x, SEXP cen, SEXP clust, SEXP clustsizes, SEXP wss, SEXP itermax, SEXP dist) { index_type numRows = static_cast<index_type>(Rf_nrows(x)); index_type numCols = static_cast<index_type>(Rf_ncols(x)); int dist_calc = INTEGER(dist)[0]; MatrixAccessor<double> mat(REAL(x), numRows); if (dist_calc==0) { return kmeansMatrixEuclid<double, MatrixAccessor<double> >(mat, numRows, numCols, cen, clust, clustsizes, wss, itermax); } else { return kmeansMatrixCosine<double, MatrixAccessor<double> >(mat, numRows, numCols, cen, clust, clustsizes, wss, itermax); } }
void setColnames(const std::vector<std::string> &cnames) { int protect_count(0); if (static_cast<R_len_t>(cnames.size()) != Rf_ncols(Robject)) { REprintf("setColnames: colnames size does not match ncols(Robject)."); return; } // check if we have existing dimnames SEXP dimnames = Rf_getAttrib(Robject, R_DimNamesSymbol); if (dimnames == R_NilValue) { PROTECT(dimnames = Rf_allocVector(VECSXP, 2)); ++protect_count; SET_VECTOR_ELT(dimnames, 0, R_NilValue); } SEXP cnames_sexp = PROTECT(Rf_allocVector(STRSXP, cnames.size())); ++protect_count; for (size_t i = 0; i < cnames.size(); ++i) { SET_STRING_ELT(cnames_sexp, i, Rf_mkChar(cnames[i].c_str())); } SET_VECTOR_ELT(dimnames, 1, cnames_sexp); Rf_setAttrib(Robject, R_DimNamesSymbol, dimnames); UNPROTECT(protect_count); }
SEXP pathSearch(SEXP Rx, SEXP Ry, SEXP Romega, SEXP Rlambda, SEXP Rkappa, SEXP Rtheta, SEXP Rn_lambda, SEXP Rn_theta, SEXP Reps, SEXP Rmax, SEXP Rinmax, SEXP Rpenalty, SEXP Rinit) { const char *penalty; int i, j, l, n, p, max, iter[1], n_lambda, n_theta, inmax; double eps; double *lambda, *y, *x, *init, *in, kappa, *theta, *omega; void cdfit(), free_vec(); SEXP betahat, betatild, Riter, return_list; p = Rf_ncols(Rx); n = Rf_nrows(Rx); Rx = coerceVector(Rx, REALSXP); Ry = coerceVector(Ry, REALSXP); Romega = coerceVector(Romega, REALSXP); Rlambda = coerceVector(Rlambda, REALSXP); Rkappa = coerceVector(Rkappa, REALSXP); Rtheta = coerceVector(Rtheta, REALSXP); Rn_lambda = coerceVector(Rn_lambda, INTSXP); Rn_theta = coerceVector(Rn_theta, INTSXP); Reps = coerceVector(Reps, REALSXP); Rinit = coerceVector(Rinit, REALSXP); Rmax = coerceVector(Rmax, INTSXP); Rinmax = coerceVector(Rinmax, INTSXP); lambda = REAL(Rlambda); kappa = REAL(Rkappa)[0]; theta = REAL(Rtheta); penalty = CHAR(STRING_ELT(Rpenalty, 0)); n_lambda = INTEGER(Rn_lambda)[0]; n_theta = INTEGER(Rn_theta)[0]; eps = REAL(Reps)[0]; max = INTEGER(Rmax)[0]; inmax = INTEGER(Rinmax)[0]; x = REAL(Rx); y = REAL(Ry); omega = REAL(Romega); in = REAL(Rinit); init = vector(p); for (j = 0; j < p; j++) init[j] = in[j]; PROTECT(betahat = Rf_allocMatrix(REALSXP, p, n_lambda * n_theta)); PROTECT(betatild = Rf_allocMatrix(REALSXP, p, n_lambda * n_theta)); PROTECT(Riter = Rf_allocMatrix(INTSXP, n_lambda, n_theta)); PROTECT(return_list = Rf_allocVector(VECSXP, 6)); /*LASSO path along lambda*/ for (i = 0; i < n_lambda; i++){ for (l = 0; l < n_theta; l++) { cdfit(x, y, omega, init, lambda[i], 0.0, theta[l], "LASSO", eps, max, inmax, n, p, iter); for (j = 0; j < p; j++) REAL(betahat)[(i + l * n_lambda) * p + j] = init[j]; INTEGER(Riter)[i + l * n_lambda] = iter[0]; }} SET_VECTOR_ELT(return_list, 0, betahat); /*MCP path along kappa with n_lambda interim points*/ if (strcmp(penalty, "MCP") == 0) { for (i = 0; i < n_lambda; i++) { for (l = 0; l < n_theta; l++) { for (j = 0; j < p; j++) init[j] = REAL(betahat)[(i + l * n_lambda) * p + j]; cdfit(x, y, omega, init, lambda[i], kappa, theta[l], "MCP", eps, max, inmax, n, p, iter); for (j = 0; j < p; j++) REAL(betatild)[(i + l * n_lambda) * p + j] = init[j]; INTEGER(Riter)[i + l * n_lambda] = iter[0]; } } } SET_VECTOR_ELT(return_list, 1, betatild); SET_VECTOR_ELT(return_list, 2, Riter); SET_VECTOR_ELT(return_list, 3, Rlambda); SET_VECTOR_ELT(return_list, 4, Rkappa); SET_VECTOR_ELT(return_list, 5, Rtheta); UNPROTECT(4); free_vector(init); return(return_list); }
R_len_t ncol() const { return Rf_ncols(Robject); }