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);
}
}
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 nrow() const { return Rf_nrows(Robject); }